1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999 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 Faces are frame-local by nature because Emacs allows to define the
69 same named face (face names are symbols) differently for different
70 frames. Each frame has an alist of face definitions for all named
71 faces. The value of a named face in such an alist is a Lisp vector
72 with the symbol `face' in slot 0, and a slot for each of the face
73 attributes mentioned above.
75 There is also a global face alist `Vface_new_frame_defaults'. Face
76 definitions from this list are used to initialize faces of newly
79 A face doesn't have to specify all attributes. Those not specified
80 have a value of `unspecified'. Faces specifying all attributes but
81 the 14th are called `fully-specified'.
86 The display style of a given character in the text is determined by
87 combining several faces. This process is called `face merging'.
88 Any aspect of the display style that isn't specified by overlays or
89 text properties is taken from the `default' face. Since it is made
90 sure that the default face is always fully-specified, face merging
91 always results in a fully-specified face.
96 After all face attributes for a character have been determined by
97 merging faces of that character, that face is `realized'. The
98 realization process maps face attributes to what is physically
99 available on the system where Emacs runs. The result is a
100 `realized face' in form of a struct face which is stored in the
101 face cache of the frame on which it was realized.
103 Face realization is done in the context of the character to display
104 because different fonts may be used for different characters. In
105 other words, for characters that have different font
106 specifications, different realized faces are needed to display
109 Font specification is done by fontsets. See the comment in
110 fontset.c for the details. In the current implementation, all ASCII
111 characters share the same font in a fontset.
113 Faces are at first realized for ASCII characters, and, at that
114 time, assigned a specific realized fontset. Hereafter, we call
115 such a face as `ASCII face'. When a face for a multibyte character
116 is realized, it inherits (thus shares) a fontset of an ASCII face
117 that has the same attributes other than font-related ones.
119 Thus, all realzied face have a realized fontset.
124 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
125 font as ASCII characters. That is because it is expected that
126 unibyte text users specify a font that is suitable both for ASCII
127 and raw 8-bit characters.
132 Font selection tries to find the best available matching font for a
133 given (character, face) combination.
135 If the face specifies a fontset name, that fontset determines a
136 pattern for fonts of the given character. If the face specifies a
137 font name or the other font-related attributes, a fontset is
138 realized from the default fontset. In that case, that
139 specification determines a pattern for ASCII characters and the
140 default fontset determines a pattern for multibyte characters.
142 Available fonts on the system on which Emacs runs are then matched
143 against the font pattern. The result of font selection is the best
144 match for the given face attributes in this font list.
146 Font selection can be influenced by the user.
148 1. The user can specify the relative importance he gives the face
149 attributes width, height, weight, and slant by setting
150 face-font-selection-order (faces.el) to a list of face attribute
151 names. The default is '(:width :height :weight :slant), and means
152 that font selection first tries to find a good match for the font
153 width specified by a face, then---within fonts with that
154 width---tries to find a best match for the specified font height,
157 2. Setting face-alternative-font-family-alist allows the user to
158 specify alternative font families to try if a family specified by a
162 Character compositition.
164 Usually, the realization process is already finished when Emacs
165 actually reflects the desired glyph matrix on the screen. However,
166 on displaying a composition (sequence of characters to be composed
167 on the screen), a suitable font for the components of the
168 composition is selected and realized while drawing them on the
169 screen, i.e. the realization process is delayed but in principle
173 Initialization of basic faces.
175 The faces `default', `modeline' are considered `basic faces'.
176 When redisplay happens the first time for a newly created frame,
177 basic faces are realized for CHARSET_ASCII. Frame parameters are
178 used to fill in unspecified attributes of the default face. */
180 /* Define SCALABLE_FONTS to a non-zero value to enable scalable
181 font use. Define it to zero to disable scalable font use.
183 Use of too many or too large scalable fonts can crash XFree86
184 servers. That's why I've put the code dealing with scalable fonts
187 #define SCALABLE_FONTS 1
190 #include <sys/types.h>
191 #include <sys/stat.h>
196 #ifdef HAVE_X_WINDOWS
201 #include <Xm/XmStrDefs.h>
202 #endif /* USE_MOTIF */
212 /* Redefine X specifics to W32 equivalents to avoid cluttering the
213 code with #ifdef blocks. */
214 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
215 #define x_display_info w32_display_info
216 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
217 #define check_x check_w32
218 #define x_list_fonts w32_list_fonts
219 #define GCGraphicsExposures 0
220 /* For historic reasons, FONT_WIDTH refers to average width on W32,
221 not maximum as on X. Redefine here. */
222 #define FONT_WIDTH FONT_MAX_WIDTH
226 #include "dispextern.h"
227 #include "blockinput.h"
229 #include "intervals.h"
231 #ifdef HAVE_X_WINDOWS
233 /* Compensate for a bug in Xos.h on some systems, on which it requires
234 time.h. On some such systems, Xos.h tries to redefine struct
235 timeval and struct timezone if USG is #defined while it is
238 #ifdef XOS_NEEDS_TIME_H
244 #else /* not XOS_NEEDS_TIME_H */
246 #endif /* not XOS_NEEDS_TIME_H */
248 #endif /* HAVE_X_WINDOWS */
252 #include "keyboard.h"
255 #define max(A, B) ((A) > (B) ? (A) : (B))
256 #define min(A, B) ((A) < (B) ? (A) : (B))
257 #define abs(X) ((X) < 0 ? -(X) : (X))
260 /* Non-zero if face attribute ATTR is unspecified. */
262 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
264 /* Value is the number of elements of VECTOR. */
266 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
268 /* Make a copy of string S on the stack using alloca. Value is a pointer
271 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
273 /* Make a copy of the contents of Lisp string S on the stack using
274 alloca. Value is a pointer to the copy. */
276 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
278 /* Size of hash table of realized faces in face caches (should be a
281 #define FACE_CACHE_BUCKETS_SIZE 1001
283 /* A definition of XColor for non-X frames. */
284 #ifndef HAVE_X_WINDOWS
287 unsigned short red
, green
, blue
;
293 /* Keyword symbols used for face attribute names. */
295 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
296 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
297 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
298 Lisp_Object QCreverse_video
;
299 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
301 /* Symbols used for attribute values. */
303 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
304 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
305 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
306 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
307 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
308 Lisp_Object Qultra_expanded
;
309 Lisp_Object Qreleased_button
, Qpressed_button
;
310 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
311 Lisp_Object Qunspecified
;
313 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
315 /* The name of the function to call when the background of the frame
316 has changed, frame_update_face_colors. */
318 Lisp_Object Qframe_update_face_colors
;
320 /* Names of basic faces. */
322 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
323 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
324 extern Lisp_Object Qmode_line
;
326 /* The symbol `face-alias'. A symbols having that property is an
327 alias for another face. Value of the property is the name of
330 Lisp_Object Qface_alias
;
332 /* Names of frame parameters related to faces. */
334 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
335 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
337 /* Default stipple pattern used on monochrome displays. This stipple
338 pattern is used on monochrome displays instead of shades of gray
339 for a face background color. See `set-face-stipple' for possible
340 values for this variable. */
342 Lisp_Object Vface_default_stipple
;
344 /* Alist of alternative font families. Each element is of the form
345 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
346 try FAMILY1, then FAMILY2, ... */
348 Lisp_Object Vface_alternative_font_family_alist
;
350 /* Allowed scalable fonts. A value of nil means don't allow any
351 scalable fonts. A value of t means allow the use of any scalable
352 font. Otherwise, value must be a list of regular expressions. A
353 font may be scaled if its name matches a regular expression in the
357 Lisp_Object Vscalable_fonts_allowed
;
360 /* Maximum number of fonts to consider in font_list. If not an
361 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
363 Lisp_Object Vfont_list_limit
;
364 #define DEFAULT_FONT_LIST_LIMIT 100
366 /* The symbols `foreground-color' and `background-color' which can be
367 used as part of a `face' property. This is for compatibility with
370 Lisp_Object Qforeground_color
, Qbackground_color
;
372 /* The symbols `face' and `mouse-face' used as text properties. */
375 extern Lisp_Object Qmouse_face
;
377 /* Error symbol for wrong_type_argument in load_pixmap. */
379 Lisp_Object Qbitmap_spec_p
;
381 /* Alist of global face definitions. Each element is of the form
382 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
383 is a Lisp vector of face attributes. These faces are used
384 to initialize faces for new frames. */
386 Lisp_Object Vface_new_frame_defaults
;
388 /* The next ID to assign to Lisp faces. */
390 static int next_lface_id
;
392 /* A vector mapping Lisp face Id's to face names. */
394 static Lisp_Object
*lface_id_to_name
;
395 static int lface_id_to_name_size
;
397 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
398 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
400 /* Counter for calls to clear_face_cache. If this counter reaches
401 CLEAR_FONT_TABLE_COUNT, and a frame has more than
402 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
404 static int clear_font_table_count
;
405 #define CLEAR_FONT_TABLE_COUNT 100
406 #define CLEAR_FONT_TABLE_NFONTS 10
408 /* Non-zero means face attributes have been changed since the last
409 redisplay. Used in redisplay_internal. */
411 int face_change_count
;
413 /* Non-zero means don't display bold text if a face's foreground
414 and background colors are the inverse of the default colors of the
415 display. This is a kluge to suppress `bold black' foreground text
416 which is hard to read on an LCD monitor. */
418 int tty_suppress_bold_inverse_default_colors_p
;
420 /* The total number of colors currently allocated. */
423 static int ncolors_allocated
;
424 static int npixmaps_allocated
;
430 /* Function prototypes. */
435 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
436 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
437 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
438 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
440 static int first_font_matching
P_ ((struct frame
*f
, char *,
441 struct font_name
*));
442 static int x_face_list_fonts
P_ ((struct frame
*, char *,
443 struct font_name
*, int, int, int));
444 static int font_scalable_p
P_ ((struct font_name
*));
445 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
446 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
447 static unsigned char *xstrlwr
P_ ((unsigned char *));
448 static void signal_error
P_ ((char *, Lisp_Object
));
449 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
450 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
451 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
452 static void free_face_colors
P_ ((struct frame
*, struct face
*));
453 static int face_color_gray_p
P_ ((struct frame
*, char *));
454 static char *build_font_name
P_ ((struct font_name
*));
455 static void free_font_names
P_ ((struct font_name
*, int));
456 static int sorted_font_list
P_ ((struct frame
*, char *,
457 int (*cmpfn
) P_ ((const void *, const void *)),
458 struct font_name
**));
459 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
460 Lisp_Object
, struct font_name
**));
461 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
462 Lisp_Object
, Lisp_Object
, struct font_name
**));
463 static int cmp_font_names
P_ ((const void *, const void *));
464 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
465 struct face
*, int));
466 static struct face
*realize_x_face
P_ ((struct face_cache
*,
467 Lisp_Object
*, int, struct face
*));
468 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
469 Lisp_Object
*, int));
470 static int realize_basic_faces
P_ ((struct frame
*));
471 static int realize_default_face
P_ ((struct frame
*));
472 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
473 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
474 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
475 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
476 static unsigned lface_hash
P_ ((Lisp_Object
*));
477 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
478 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
479 static void free_realized_face
P_ ((struct frame
*, struct face
*));
480 static void clear_face_gcs
P_ ((struct face_cache
*));
481 static void free_face_cache
P_ ((struct face_cache
*));
482 static int face_numeric_weight
P_ ((Lisp_Object
));
483 static int face_numeric_slant
P_ ((Lisp_Object
));
484 static int face_numeric_swidth
P_ ((Lisp_Object
));
485 static int face_fontset
P_ ((Lisp_Object
*));
486 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
487 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
488 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
490 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
491 Lisp_Object
, int, int));
492 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
493 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
494 static void free_realized_faces
P_ ((struct face_cache
*));
495 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
496 struct font_name
*, int));
497 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
498 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
499 static int xlfd_numeric_slant
P_ ((struct font_name
*));
500 static int xlfd_numeric_weight
P_ ((struct font_name
*));
501 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
502 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
503 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
504 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
505 static int xlfd_fixed_p
P_ ((struct font_name
*));
506 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
508 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
509 struct font_name
*, int,
511 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
512 struct font_name
*, int));
514 #ifdef HAVE_WINDOW_SYSTEM
516 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
517 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
518 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
519 int (*cmpfn
) P_ ((const void *, const void *))));
520 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
521 static void x_free_gc
P_ ((struct frame
*, GC
));
522 static void clear_font_table
P_ ((struct frame
*));
525 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
526 #endif /* WINDOWSNT */
528 #endif /* HAVE_WINDOW_SYSTEM */
531 /***********************************************************************
533 ***********************************************************************/
535 #ifdef HAVE_X_WINDOWS
537 #ifdef DEBUG_X_COLORS
539 /* The following is a poor mans infrastructure for debugging X color
540 allocation problems on displays with PseudoColor-8. Some X servers
541 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
542 color reference counts completely so that they don't signal an
543 error when a color is freed whose reference count is already 0.
544 Other X servers do. To help me debug this, the following code
545 implements a simple reference counting schema of its own, for a
546 single display/screen. --gerd. */
548 /* Reference counts for pixel colors. */
550 int color_count
[256];
552 /* Register color PIXEL as allocated. */
555 register_color (pixel
)
558 xassert (pixel
< 256);
559 ++color_count
[pixel
];
563 /* Register color PIXEL as deallocated. */
566 unregister_color (pixel
)
569 xassert (pixel
< 256);
570 if (color_count
[pixel
] > 0)
571 --color_count
[pixel
];
577 /* Register N colors from PIXELS as deallocated. */
580 unregister_colors (pixels
, n
)
581 unsigned long *pixels
;
585 for (i
= 0; i
< n
; ++i
)
586 unregister_color (pixels
[i
]);
589 #endif /* DEBUG_X_COLORS */
591 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
592 color values. Interrupt input must be blocked when this function
596 x_free_colors (f
, pixels
, npixels
)
598 unsigned long *pixels
;
601 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
603 /* If display has an immutable color map, freeing colors is not
604 necessary and some servers don't allow it. So don't do it. */
605 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
607 Display
*dpy
= FRAME_X_DISPLAY (f
);
608 Colormap cmap
= FRAME_X_COLORMAP (f
);
609 Screen
*screen
= FRAME_X_SCREEN (f
);
610 int default_cmap_p
= cmap
== DefaultColormapOfScreen (screen
);
614 /* Be paranoid. If using the default color map, don't ever
615 try to free the default black and white colors. */
616 int screen_no
= XScreenNumberOfScreen (screen
);
617 unsigned long black
= BlackPixel (dpy
, screen_no
);
618 unsigned long white
= WhitePixel (dpy
, screen_no
);
622 px
= (unsigned long *) alloca (npixels
* sizeof *px
);
623 for (i
= j
= 0; i
< npixels
; ++i
)
624 if (pixels
[i
] != black
&& pixels
[i
] != white
)
629 XFreeColors (dpy
, cmap
, px
, j
, 0);
630 #ifdef DEBUG_X_COLORS
631 unregister_colors (px
, j
);
637 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
638 #ifdef DEBUG_X_COLORS
639 unregister_colors (pixels
, npixels
);
645 /* Create and return a GC for use on frame F. GC values and mask
646 are given by XGCV and MASK. */
649 x_create_gc (f
, mask
, xgcv
)
656 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
663 /* Free GC which was used on frame F. */
671 xassert (--ngcs
>= 0);
672 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
676 #endif /* HAVE_X_WINDOWS */
679 /* W32 emulation of GCs */
682 x_create_gc (f
, mask
, xgcv
)
689 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
696 /* Free GC which was used on frame F. */
704 xassert (--ngcs
>= 0);
709 #endif /* WINDOWSNT */
711 /* Like stricmp. Used to compare parts of font names which are in
716 unsigned char *s1
, *s2
;
720 unsigned char c1
= tolower (*s1
);
721 unsigned char c2
= tolower (*s2
);
723 return c1
< c2
? -1 : 1;
728 return *s2
== 0 ? 0 : -1;
733 /* Like strlwr, which might not always be available. */
735 static unsigned char *
739 unsigned char *p
= s
;
748 /* Signal `error' with message S, and additional argument ARG. */
751 signal_error (s
, arg
)
755 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
759 /* If FRAME is nil, return a pointer to the selected frame.
760 Otherwise, check that FRAME is a live frame, and return a pointer
761 to it. NPARAM is the parameter number of FRAME, for
762 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
763 Lisp function definitions. */
765 static INLINE
struct frame
*
766 frame_or_selected_frame (frame
, nparam
)
771 frame
= selected_frame
;
773 CHECK_LIVE_FRAME (frame
, nparam
);
774 return XFRAME (frame
);
778 /***********************************************************************
780 ***********************************************************************/
782 /* Initialize face cache and basic faces for frame F. */
788 /* Make a face cache, if F doesn't have one. */
789 if (FRAME_FACE_CACHE (f
) == NULL
)
790 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
792 #ifdef HAVE_WINDOW_SYSTEM
793 /* Make the image cache. */
794 if (FRAME_WINDOW_P (f
))
796 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
797 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
798 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
800 #endif /* HAVE_WINDOW_SYSTEM */
802 /* Realize basic faces. Must have enough information in frame
803 parameters to realize basic faces at this point. */
804 #ifdef HAVE_X_WINDOWS
805 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
808 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
810 if (!realize_basic_faces (f
))
815 /* Free face cache of frame F. Called from Fdelete_frame. */
821 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
825 free_face_cache (face_cache
);
826 FRAME_FACE_CACHE (f
) = NULL
;
829 #ifdef HAVE_WINDOW_SYSTEM
830 if (FRAME_WINDOW_P (f
))
832 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
835 --image_cache
->refcount
;
836 if (image_cache
->refcount
== 0)
837 free_image_cache (f
);
840 #endif /* HAVE_WINDOW_SYSTEM */
844 /* Clear face caches, and recompute basic faces for frame F. Call
845 this after changing frame parameters on which those faces depend,
846 or when realized faces have been freed due to changing attributes
850 recompute_basic_faces (f
)
853 if (FRAME_FACE_CACHE (f
))
855 clear_face_cache (0);
856 if (!realize_basic_faces (f
))
862 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
863 try to free unused fonts, too. */
866 clear_face_cache (clear_fonts_p
)
869 #ifdef HAVE_WINDOW_SYSTEM
870 Lisp_Object tail
, frame
;
874 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
876 /* From time to time see if we can unload some fonts. This also
877 frees all realized faces on all frames. Fonts needed by
878 faces will be loaded again when faces are realized again. */
879 clear_font_table_count
= 0;
881 FOR_EACH_FRAME (tail
, frame
)
884 if (FRAME_WINDOW_P (f
)
885 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
887 free_all_realized_faces (frame
);
888 clear_font_table (f
);
894 /* Clear GCs of realized faces. */
895 FOR_EACH_FRAME (tail
, frame
)
898 if (FRAME_WINDOW_P (f
))
900 clear_face_gcs (FRAME_FACE_CACHE (f
));
901 clear_image_cache (f
, 0);
905 #endif /* HAVE_WINDOW_SYSTEM */
909 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
910 "Clear face caches on all frames.\n\
911 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
913 Lisp_Object thorougly
;
915 clear_face_cache (!NILP (thorougly
));
921 #ifdef HAVE_WINDOW_SYSTEM
924 /* Remove those fonts from the font table of frame F exept for the
925 default ASCII font for the frame. Called from clear_face_cache
926 from time to time. */
932 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
933 Lisp_Object rest
, frame
;
936 xassert (FRAME_WINDOW_P (f
));
938 /* Free those fonts that are not used by the frame F as the default. */
939 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
941 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
944 || font_info
->font
== FRAME_FONT (f
))
948 if (font_info
->full_name
!= font_info
->name
)
949 xfree (font_info
->full_name
);
950 xfree (font_info
->name
);
954 #ifdef HAVE_X_WINDOWS
955 XFreeFont (dpyinfo
->display
, font_info
->font
);
958 w32_unload_font (dpyinfo
, font_info
->font
);
962 /* Mark font table slot free. */
963 font_info
->font
= NULL
;
964 font_info
->name
= font_info
->full_name
= NULL
;
968 #endif /* HAVE_WINDOW_SYSTEM */
972 /***********************************************************************
974 ***********************************************************************/
976 #ifdef HAVE_WINDOW_SYSTEM
978 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
979 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
980 A bitmap specification is either a string, a file name, or a list\n\
981 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
982 HEIGHT is its height, and DATA is a string containing the bits of\n\
983 the pixmap. Bits are stored row by row, each row occupies\n\
984 (WIDTH + 7)/8 bytes.")
990 if (STRINGP (object
))
991 /* If OBJECT is a string, it's a file name. */
993 else if (CONSP (object
))
995 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
996 HEIGHT must be integers > 0, and DATA must be string large
997 enough to hold a bitmap of the specified size. */
998 Lisp_Object width
, height
, data
;
1000 height
= width
= data
= Qnil
;
1004 width
= XCAR (object
);
1005 object
= XCDR (object
);
1008 height
= XCAR (object
);
1009 object
= XCDR (object
);
1011 data
= XCAR (object
);
1015 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1017 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1019 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1024 return pixmap_p
? Qt
: Qnil
;
1028 /* Load a bitmap according to NAME (which is either a file name or a
1029 pixmap spec) for use on frame F. Value is the bitmap_id (see
1030 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1031 bitmap cannot be loaded, display a message saying so, and return
1032 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1033 if these pointers are not null. */
1036 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1039 unsigned int *w_ptr
, *h_ptr
;
1047 tem
= Fbitmap_spec_p (name
);
1049 wrong_type_argument (Qbitmap_spec_p
, name
);
1054 /* Decode a bitmap spec into a bitmap. */
1059 w
= XINT (Fcar (name
));
1060 h
= XINT (Fcar (Fcdr (name
)));
1061 bits
= Fcar (Fcdr (Fcdr (name
)));
1063 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1068 /* It must be a string -- a file name. */
1069 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1075 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1086 ++npixmaps_allocated
;
1089 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1092 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1098 #endif /* HAVE_WINDOW_SYSTEM */
1102 /***********************************************************************
1104 ***********************************************************************/
1106 #ifdef HAVE_WINDOW_SYSTEM
1108 /* Update the line_height of frame F. Return non-zero if line height
1112 frame_update_line_height (f
)
1115 int line_height
, changed_p
;
1117 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1118 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1119 FRAME_LINE_HEIGHT (f
) = line_height
;
1123 #endif /* HAVE_WINDOW_SYSTEM */
1126 /***********************************************************************
1128 ***********************************************************************/
1130 #ifdef HAVE_WINDOW_SYSTEM
1132 /* Load font of face FACE which is used on frame F to display
1133 character C. The name of the font to load is determined by lface
1134 and fontset of FACE. */
1137 load_face_font (f
, face
, c
)
1142 struct font_info
*font_info
= NULL
;
1145 face
->font_info_id
= -1;
1148 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1153 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1158 face
->font_info_id
= font_info
->font_idx
;
1159 face
->font
= font_info
->font
;
1160 face
->font_name
= font_info
->full_name
;
1163 x_free_gc (f
, face
->gc
);
1168 add_to_log ("Unable to load font %s",
1169 build_string (font_name
), Qnil
);
1173 #endif /* HAVE_WINDOW_SYSTEM */
1177 /***********************************************************************
1179 ***********************************************************************/
1181 /* A version of defined_color for non-X frames. */
1183 tty_defined_color (f
, color_name
, color_def
, alloc
)
1189 Lisp_Object color_desc
;
1190 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
,
1191 red
= 0, green
= 0, blue
= 0;
1194 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1198 XSETFRAME (frame
, f
);
1200 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1201 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1203 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1204 if (CONSP (XCDR (XCDR (color_desc
))))
1206 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1207 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1208 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1212 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1213 /* We were called early during startup, and the colors are not
1214 yet set up in tty-defined-color-alist. Don't return a failure
1215 indication, since this produces the annoying "Unable to
1216 load color" messages in the *Messages* buffer. */
1219 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1221 if (strcmp (color_name
, "unspecified-fg") == 0)
1222 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1223 else if (strcmp (color_name
, "unspecified-bg") == 0)
1224 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1227 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1230 color_def
->pixel
= color_idx
;
1231 color_def
->red
= red
;
1232 color_def
->green
= green
;
1233 color_def
->blue
= blue
;
1238 /* Decide if color named COLOR is valid for the display associated
1239 with the frame F; if so, return the rgb values in COLOR_DEF. If
1240 ALLOC is nonzero, allocate a new colormap cell.
1242 This does the right thing for any type of frame. */
1244 defined_color (f
, color_name
, color_def
, alloc
)
1250 if (!FRAME_WINDOW_P (f
))
1251 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1252 #ifdef HAVE_X_WINDOWS
1253 else if (FRAME_X_P (f
))
1254 return x_defined_color (f
, color_name
, color_def
, alloc
);
1257 else if (FRAME_W32_P (f
))
1258 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1261 else if (FRAME_MAC_P (f
))
1262 /* FIXME: mac_defined_color doesn't exist! */
1263 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1269 /* Given the index of the tty color, return its name, a Lisp string. */
1272 tty_color_name (f
, idx
)
1278 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1281 Lisp_Object coldesc
;
1283 XSETFRAME (frame
, f
);
1284 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1286 if (!NILP (coldesc
))
1287 return XCAR (coldesc
);
1290 /* We can have an MSDOG frame under -nw for a short window of
1291 opportunity before internal_terminal_init is called. DTRT. */
1292 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1293 return msdos_stdcolor_name (idx
);
1296 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1297 return build_string (unspecified_fg
);
1298 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1299 return build_string (unspecified_bg
);
1302 return vga_stdcolor_name (idx
);
1305 return Qunspecified
;
1308 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1309 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1312 face_color_gray_p (f
, color_name
)
1319 if (defined_color (f
, color_name
, &color
, 0))
1320 gray_p
= ((abs (color
.red
- color
.green
)
1321 < max (color
.red
, color
.green
) / 20)
1322 && (abs (color
.green
- color
.blue
)
1323 < max (color
.green
, color
.blue
) / 20)
1324 && (abs (color
.blue
- color
.red
)
1325 < max (color
.blue
, color
.red
) / 20));
1333 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1334 BACKGROUND_P non-zero means the color will be used as background
1338 face_color_supported_p (f
, color_name
, background_p
)
1346 XSETFRAME (frame
, f
);
1347 return (FRAME_WINDOW_P (f
)
1348 ? (!NILP (Fxw_display_color_p (frame
))
1349 || xstricmp (color_name
, "black") == 0
1350 || xstricmp (color_name
, "white") == 0
1352 && face_color_gray_p (f
, color_name
))
1353 || (!NILP (Fx_display_grayscale_p (frame
))
1354 && face_color_gray_p (f
, color_name
)))
1355 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1359 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1360 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1361 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1362 If FRAME is nil or omitted, use the selected frame.")
1364 Lisp_Object color
, frame
;
1368 CHECK_FRAME (frame
, 0);
1369 CHECK_STRING (color
, 0);
1371 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1375 DEFUN ("color-supported-p", Fcolor_supported_p
,
1376 Scolor_supported_p
, 2, 3, 0,
1377 "Return non-nil if COLOR can be displayed on FRAME.\n\
1378 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1379 If FRAME is nil or omitted, use the selected frame.\n\
1380 COLOR must be a valid color name.")
1381 (color
, frame
, background_p
)
1382 Lisp_Object frame
, color
, background_p
;
1386 CHECK_FRAME (frame
, 0);
1387 CHECK_STRING (color
, 0);
1389 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1394 /* Load color with name NAME for use by face FACE on frame F.
1395 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1396 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1397 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1398 pixel color. If color cannot be loaded, display a message, and
1399 return the foreground, background or underline color of F, but
1400 record that fact in flags of the face so that we don't try to free
1404 load_color (f
, face
, name
, target_index
)
1408 enum lface_attribute_index target_index
;
1412 xassert (STRINGP (name
));
1413 xassert (target_index
== LFACE_FOREGROUND_INDEX
1414 || target_index
== LFACE_BACKGROUND_INDEX
1415 || target_index
== LFACE_UNDERLINE_INDEX
1416 || target_index
== LFACE_OVERLINE_INDEX
1417 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1418 || target_index
== LFACE_BOX_INDEX
);
1420 /* if the color map is full, defined_color will return a best match
1421 to the values in an existing cell. */
1422 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1424 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1426 switch (target_index
)
1428 case LFACE_FOREGROUND_INDEX
:
1429 face
->foreground_defaulted_p
= 1;
1430 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1433 case LFACE_BACKGROUND_INDEX
:
1434 face
->background_defaulted_p
= 1;
1435 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1438 case LFACE_UNDERLINE_INDEX
:
1439 face
->underline_defaulted_p
= 1;
1440 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1443 case LFACE_OVERLINE_INDEX
:
1444 face
->overline_color_defaulted_p
= 1;
1445 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1448 case LFACE_STRIKE_THROUGH_INDEX
:
1449 face
->strike_through_color_defaulted_p
= 1;
1450 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1453 case LFACE_BOX_INDEX
:
1454 face
->box_color_defaulted_p
= 1;
1455 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1464 ++ncolors_allocated
;
1470 #ifdef HAVE_WINDOW_SYSTEM
1472 /* Load colors for face FACE which is used on frame F. Colors are
1473 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1474 of ATTRS. If the background color specified is not supported on F,
1475 try to emulate gray colors with a stipple from Vface_default_stipple. */
1478 load_face_colors (f
, face
, attrs
)
1485 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1486 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1488 /* Swap colors if face is inverse-video. */
1489 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1497 /* Check for support for foreground, not for background because
1498 face_color_supported_p is smart enough to know that grays are
1499 "supported" as background because we are supposed to use stipple
1501 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1502 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1504 x_destroy_bitmap (f
, face
->stipple
);
1505 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1506 &face
->pixmap_w
, &face
->pixmap_h
);
1509 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1510 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1514 /* Free color PIXEL on frame F. */
1517 unload_color (f
, pixel
)
1519 unsigned long pixel
;
1521 #ifdef HAVE_X_WINDOWS
1523 x_free_colors (f
, &pixel
, 1);
1529 /* Free colors allocated for FACE. */
1532 free_face_colors (f
, face
)
1536 #ifdef HAVE_X_WINDOWS
1537 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1539 /* If display has an immutable color map, freeing colors is not
1540 necessary and some servers don't allow it. So don't do it. */
1541 if (class != StaticColor
1542 && class != StaticGray
1543 && class != TrueColor
)
1547 if (!face
->foreground_defaulted_p
)
1549 x_free_colors (f
, &face
->foreground
, 1);
1550 IF_DEBUG (--ncolors_allocated
);
1553 if (!face
->background_defaulted_p
)
1555 x_free_colors (f
, &face
->background
, 1);
1556 IF_DEBUG (--ncolors_allocated
);
1559 if (face
->underline_p
1560 && !face
->underline_defaulted_p
)
1562 x_free_colors (f
, &face
->underline_color
, 1);
1563 IF_DEBUG (--ncolors_allocated
);
1566 if (face
->overline_p
1567 && !face
->overline_color_defaulted_p
)
1569 x_free_colors (f
, &face
->overline_color
, 1);
1570 IF_DEBUG (--ncolors_allocated
);
1573 if (face
->strike_through_p
1574 && !face
->strike_through_color_defaulted_p
)
1576 x_free_colors (f
, &face
->strike_through_color
, 1);
1577 IF_DEBUG (--ncolors_allocated
);
1580 if (face
->box
!= FACE_NO_BOX
1581 && !face
->box_color_defaulted_p
)
1583 x_free_colors (f
, &face
->box_color
, 1);
1584 IF_DEBUG (--ncolors_allocated
);
1589 #endif /* HAVE_X_WINDOWS */
1591 #endif /* HAVE_WINDOW_SYSTEM */
1595 /***********************************************************************
1597 ***********************************************************************/
1599 /* An enumerator for each field of an XLFD font name. */
1620 /* An enumerator for each possible slant value of a font. Taken from
1621 the XLFD specification. */
1629 XLFD_SLANT_REVERSE_ITALIC
,
1630 XLFD_SLANT_REVERSE_OBLIQUE
,
1634 /* Relative font weight according to XLFD documentation. */
1638 XLFD_WEIGHT_UNKNOWN
,
1639 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1640 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1641 XLFD_WEIGHT_LIGHT
, /* 30 */
1642 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1643 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1644 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1645 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1646 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1647 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1650 /* Relative proportionate width. */
1654 XLFD_SWIDTH_UNKNOWN
,
1655 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1656 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1657 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1658 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1659 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1660 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1661 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1662 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1663 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1666 /* Structure used for tables mapping XLFD weight, slant, and width
1667 names to numeric and symbolic values. */
1673 Lisp_Object
*symbol
;
1676 /* Table of XLFD slant names and their numeric and symbolic
1677 representations. This table must be sorted by slant names in
1680 static struct table_entry slant_table
[] =
1682 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1683 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1684 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1685 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1686 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1687 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1690 /* Table of XLFD weight names. This table must be sorted by weight
1691 names in ascending order. */
1693 static struct table_entry weight_table
[] =
1695 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1696 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1697 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1698 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1699 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1700 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1701 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1702 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1703 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1704 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1705 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1706 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1707 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1708 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1709 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1712 /* Table of XLFD width names. This table must be sorted by width
1713 names in ascending order. */
1715 static struct table_entry swidth_table
[] =
1717 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1718 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1719 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1720 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1721 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1722 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1723 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1724 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1725 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1726 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1727 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1728 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1729 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1730 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1731 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1734 /* Structure used to hold the result of splitting font names in XLFD
1735 format into their fields. */
1739 /* The original name which is modified destructively by
1740 split_font_name. The pointer is kept here to be able to free it
1741 if it was allocated from the heap. */
1744 /* Font name fields. Each vector element points into `name' above.
1745 Fields are NUL-terminated. */
1746 char *fields
[XLFD_LAST
];
1748 /* Numeric values for those fields that interest us. See
1749 split_font_name for which these are. */
1750 int numeric
[XLFD_LAST
];
1753 /* The frame in effect when sorting font names. Set temporarily in
1754 sort_fonts so that it is available in font comparison functions. */
1756 static struct frame
*font_frame
;
1758 /* Order by which font selection chooses fonts. The default values
1759 mean `first, find a best match for the font width, then for the
1760 font height, then for weight, then for slant.' This variable can be
1761 set via set-face-font-sort-order. */
1763 static int font_sort_order
[4];
1766 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1767 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1768 is a pointer to the matching table entry or null if no table entry
1771 static struct table_entry
*
1772 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1773 struct table_entry
*table
;
1775 struct font_name
*font
;
1778 /* Function split_font_name converts fields to lower-case, so there
1779 is no need to use xstrlwr or xstricmp here. */
1780 char *s
= font
->fields
[field_index
];
1781 int low
, mid
, high
, cmp
;
1788 mid
= (low
+ high
) / 2;
1789 cmp
= strcmp (table
[mid
].name
, s
);
1803 /* Return a numeric representation for font name field
1804 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1805 has DIM entries. Value is the numeric value found or DFLT if no
1806 table entry matches. This function is used to translate weight,
1807 slant, and swidth names of XLFD font names to numeric values. */
1810 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1811 struct table_entry
*table
;
1813 struct font_name
*font
;
1817 struct table_entry
*p
;
1818 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1819 return p
? p
->numeric
: dflt
;
1823 /* Return a symbolic representation for font name field
1824 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1825 has DIM entries. Value is the symbolic value found or DFLT if no
1826 table entry matches. This function is used to translate weight,
1827 slant, and swidth names of XLFD font names to symbols. */
1829 static INLINE Lisp_Object
1830 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1831 struct table_entry
*table
;
1833 struct font_name
*font
;
1837 struct table_entry
*p
;
1838 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1839 return p
? *p
->symbol
: dflt
;
1843 /* Return a numeric value for the slant of the font given by FONT. */
1846 xlfd_numeric_slant (font
)
1847 struct font_name
*font
;
1849 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1850 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1854 /* Return a symbol representing the weight of the font given by FONT. */
1856 static INLINE Lisp_Object
1857 xlfd_symbolic_slant (font
)
1858 struct font_name
*font
;
1860 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1861 font
, XLFD_SLANT
, Qnormal
);
1865 /* Return a numeric value for the weight of the font given by FONT. */
1868 xlfd_numeric_weight (font
)
1869 struct font_name
*font
;
1871 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1872 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1876 /* Return a symbol representing the slant of the font given by FONT. */
1878 static INLINE Lisp_Object
1879 xlfd_symbolic_weight (font
)
1880 struct font_name
*font
;
1882 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1883 font
, XLFD_WEIGHT
, Qnormal
);
1887 /* Return a numeric value for the swidth of the font whose XLFD font
1888 name fields are found in FONT. */
1891 xlfd_numeric_swidth (font
)
1892 struct font_name
*font
;
1894 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1895 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1899 /* Return a symbolic value for the swidth of FONT. */
1901 static INLINE Lisp_Object
1902 xlfd_symbolic_swidth (font
)
1903 struct font_name
*font
;
1905 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1906 font
, XLFD_SWIDTH
, Qnormal
);
1910 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1911 entries. Value is a pointer to the matching table entry or null if
1912 no element of TABLE contains SYMBOL. */
1914 static struct table_entry
*
1915 face_value (table
, dim
, symbol
)
1916 struct table_entry
*table
;
1922 xassert (SYMBOLP (symbol
));
1924 for (i
= 0; i
< dim
; ++i
)
1925 if (EQ (*table
[i
].symbol
, symbol
))
1928 return i
< dim
? table
+ i
: NULL
;
1932 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1933 entries. Value is -1 if SYMBOL is not found in TABLE. */
1936 face_numeric_value (table
, dim
, symbol
)
1937 struct table_entry
*table
;
1941 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1942 return p
? p
->numeric
: -1;
1946 /* Return a numeric value representing the weight specified by Lisp
1947 symbol WEIGHT. Value is one of the enumerators of enum
1951 face_numeric_weight (weight
)
1954 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1958 /* Return a numeric value representing the slant specified by Lisp
1959 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1962 face_numeric_slant (slant
)
1965 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1969 /* Return a numeric value representing the swidth specified by Lisp
1970 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1973 face_numeric_swidth (width
)
1976 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1980 #ifdef HAVE_WINDOW_SYSTEM
1982 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1986 struct font_name
*font
;
1988 /* Function split_font_name converts fields to lower-case, so there
1989 is no need to use tolower here. */
1990 return *font
->fields
[XLFD_SPACING
] != 'p';
1994 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1996 The actual height of the font when displayed on F depends on the
1997 resolution of both the font and frame. For example, a 10pt font
1998 designed for a 100dpi display will display larger than 10pt on a
1999 75dpi display. (It's not unusual to use fonts not designed for the
2000 display one is using. For example, some intlfonts are available in
2001 72dpi versions, only.)
2003 Value is the real point size of FONT on frame F, or 0 if it cannot
2007 xlfd_point_size (f
, font
)
2009 struct font_name
*font
;
2011 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2012 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2013 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2016 if (font_resy
== 0 || font_pt
== 0)
2019 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2025 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2026 of frame F. This function is used to guess a point size of font
2027 when only the pixel height of the font is available. */
2030 pixel_point_size (f
, pixel
)
2034 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2038 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2039 real_pt
= pixel
* 72 / resy
;
2040 int_pt
= real_pt
+ 0.5;
2046 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2047 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2048 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2049 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2050 zero if the font name doesn't have the format we expect. The
2051 expected format is a font name that starts with a `-' and has
2052 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2053 forms of font names where certain field contents are enclosed in
2054 square brackets. We don't support that, for now. */
2057 split_font_name (f
, font
, numeric_p
)
2059 struct font_name
*font
;
2065 if (*font
->name
== '-')
2067 char *p
= xstrlwr (font
->name
) + 1;
2069 while (i
< XLFD_LAST
)
2071 font
->fields
[i
] = p
;
2074 while (*p
&& *p
!= '-')
2084 success_p
= i
== XLFD_LAST
;
2086 /* If requested, and font name was in the expected format,
2087 compute numeric values for some fields. */
2088 if (numeric_p
&& success_p
)
2090 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2091 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2092 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2093 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2094 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2101 /* Build an XLFD font name from font name fields in FONT. Value is a
2102 pointer to the font name, which is allocated via xmalloc. */
2105 build_font_name (font
)
2106 struct font_name
*font
;
2110 char *font_name
= (char *) xmalloc (size
);
2111 int total_length
= 0;
2113 for (i
= 0; i
< XLFD_LAST
; ++i
)
2115 /* Add 1 because of the leading `-'. */
2116 int len
= strlen (font
->fields
[i
]) + 1;
2118 /* Reallocate font_name if necessary. Add 1 for the final
2120 if (total_length
+ len
+ 1 >= size
)
2122 int new_size
= max (2 * size
, size
+ len
+ 1);
2123 int sz
= new_size
* sizeof *font_name
;
2124 font_name
= (char *) xrealloc (font_name
, sz
);
2128 font_name
[total_length
] = '-';
2129 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2130 total_length
+= len
;
2133 font_name
[total_length
] = 0;
2138 /* Free an array FONTS of N font_name structures. This frees FONTS
2139 itself and all `name' fields in its elements. */
2142 free_font_names (fonts
, n
)
2143 struct font_name
*fonts
;
2147 xfree (fonts
[--n
].name
);
2152 /* Sort vector FONTS of font_name structures which contains NFONTS
2153 elements using qsort and comparison function CMPFN. F is the frame
2154 on which the fonts will be used. The global variable font_frame
2155 is temporarily set to F to make it available in CMPFN. */
2158 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2160 struct font_name
*fonts
;
2162 int (*cmpfn
) P_ ((const void *, const void *));
2165 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2170 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2171 display in x_display_list. FONTS is a pointer to a vector of
2172 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2173 alternative patterns from Valternate_fontname_alist if no fonts are
2174 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2177 For all fonts found, set FONTS[i].name to the name of the font,
2178 allocated via xmalloc, and split font names into fields. Ignore
2179 fonts that we can't parse. Value is the number of fonts found.
2181 This is similar to x_list_fonts. The differences are:
2183 1. It avoids consing.
2184 2. It never calls XLoadQueryFont. */
2187 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2191 struct font_name
*fonts
;
2192 int nfonts
, try_alternatives_p
;
2193 int scalable_fonts_p
;
2197 #ifdef HAVE_X_WINDOWS
2198 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2200 /* Get the list of fonts matching PATTERN from the X server. */
2202 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2206 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2207 better to do it the other way around. */
2209 Lisp_Object lpattern
, tem
;
2214 lpattern
= build_string (pattern
);
2216 /* Get the list of fonts matching PATTERN. */
2218 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2221 /* Count fonts returned */
2222 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2225 /* Allocate array. */
2227 names
= (char **) xmalloc (n
* sizeof (char *));
2229 /* Extract font names into char * array. */
2231 for (i
= 0; i
< n
; i
++)
2233 names
[i
] = XSTRING (XCAR (tem
))->data
;
2240 /* Make a copy of the font names we got from X, and
2241 split them into fields. */
2242 for (i
= j
= 0; i
< n
; ++i
)
2244 /* Make a copy of the font name. */
2245 fonts
[j
].name
= xstrdup (names
[i
]);
2247 /* Ignore fonts having a name that we can't parse. */
2248 if (!split_font_name (f
, fonts
+ j
, 1))
2249 xfree (fonts
[j
].name
);
2250 else if (font_scalable_p (fonts
+ j
))
2253 if (!scalable_fonts_p
2254 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2255 xfree (fonts
[j
].name
);
2258 #else /* !SCALABLE_FONTS */
2259 /* Always ignore scalable fonts. */
2260 xfree (fonts
[j
].name
);
2261 #endif /* !SCALABLE_FONTS */
2269 #ifdef HAVE_X_WINDOWS
2270 /* Free font names. */
2272 XFreeFontNames (names
);
2278 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2279 if (n
== 0 && try_alternatives_p
)
2281 Lisp_Object list
= Valternate_fontname_alist
;
2283 while (CONSP (list
))
2285 Lisp_Object entry
= XCAR (list
);
2287 && STRINGP (XCAR (entry
))
2288 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2295 Lisp_Object patterns
= XCAR (list
);
2298 while (CONSP (patterns
)
2299 /* If list is screwed up, give up. */
2300 && (name
= XCAR (patterns
),
2302 /* Ignore patterns equal to PATTERN because we tried that
2303 already with no success. */
2304 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2305 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2309 patterns
= XCDR (patterns
);
2317 /* Determine the first font matching PATTERN on frame F. Return in
2318 *FONT the matching font name, split into fields. Value is non-zero
2319 if a match was found. */
2322 first_font_matching (f
, pattern
, font
)
2325 struct font_name
*font
;
2328 struct font_name
*fonts
;
2330 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2331 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2335 bcopy (&fonts
[0], font
, sizeof *font
);
2337 fonts
[0].name
= NULL
;
2338 free_font_names (fonts
, nfonts
);
2345 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2346 using comparison function CMPFN. Value is the number of fonts
2347 found. If value is non-zero, *FONTS is set to a vector of
2348 font_name structures allocated from the heap containing matching
2349 fonts. Each element of *FONTS contains a name member that is also
2350 allocated from the heap. Font names in these structures are split
2351 into fields. Use free_font_names to free such an array. */
2354 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2357 int (*cmpfn
) P_ ((const void *, const void *));
2358 struct font_name
**fonts
;
2362 /* Get the list of fonts matching pattern. 100 should suffice. */
2363 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2364 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2365 nfonts
= XFASTINT (Vfont_list_limit
);
2367 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2369 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2371 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2374 /* Sort the resulting array and return it in *FONTS. If no
2375 fonts were found, make sure to set *FONTS to null. */
2377 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2388 /* Compare two font_name structures *A and *B. Value is analogous to
2389 strcmp. Sort order is given by the global variable
2390 font_sort_order. Font names are sorted so that, everything else
2391 being equal, fonts with a resolution closer to that of the frame on
2392 which they are used are listed first. The global variable
2393 font_frame is the frame on which we operate. */
2396 cmp_font_names (a
, b
)
2399 struct font_name
*x
= (struct font_name
*) a
;
2400 struct font_name
*y
= (struct font_name
*) b
;
2403 /* All strings have been converted to lower-case by split_font_name,
2404 so we can use strcmp here. */
2405 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2410 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2412 int j
= font_sort_order
[i
];
2413 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2418 /* Everything else being equal, we prefer fonts with an
2419 y-resolution closer to that of the frame. */
2420 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2421 int x_resy
= x
->numeric
[XLFD_RESY
];
2422 int y_resy
= y
->numeric
[XLFD_RESY
];
2423 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2431 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2432 is non-nil list fonts matching that pattern. Otherwise, if
2433 REGISTRY is non-nil return only fonts with that registry, otherwise
2434 return fonts of any registry. Set *FONTS to a vector of font_name
2435 structures allocated from the heap containing the fonts found.
2436 Value is the number of fonts found. */
2439 font_list (f
, pattern
, family
, registry
, fonts
)
2441 Lisp_Object pattern
, family
, registry
;
2442 struct font_name
**fonts
;
2444 char *pattern_str
, *family_str
, *registry_str
;
2448 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2449 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2451 pattern_str
= (char *) alloca (strlen (family_str
)
2452 + strlen (registry_str
)
2454 if (index (family_str
, '-'))
2455 sprintf (pattern_str
, "-%s-*-%s", family_str
, registry_str
);
2457 sprintf (pattern_str
, "-*-%s-*-%s", family_str
, registry_str
);
2460 pattern_str
= (char *) XSTRING (pattern
)->data
;
2462 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2466 /* Remove elements from LIST whose cars are `equal'. Called from
2467 x-family-fonts and x-font-family-list to remove duplicate font
2471 remove_duplicates (list
)
2474 Lisp_Object tail
= list
;
2476 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2478 Lisp_Object next
= XCDR (tail
);
2479 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2480 XCDR (tail
) = XCDR (next
);
2487 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2488 "Return a list of available fonts of family FAMILY on FRAME.\n\
2489 If FAMILY is omitted or nil, list all families.\n\
2490 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2492 If FRAME is omitted or nil, use the selected frame.\n\
2493 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2494 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2495 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2496 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2497 width, weight and slant of the font. These symbols are the same as for\n\
2498 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2499 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2500 giving the registry and encoding of the font.\n\
2501 The result list is sorted according to the current setting of\n\
2502 the face font sort order.")
2504 Lisp_Object family
, frame
;
2506 struct frame
*f
= check_x_frame (frame
);
2507 struct font_name
*fonts
;
2510 struct gcpro gcpro1
;
2513 CHECK_STRING (family
, 1);
2517 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2518 for (i
= nfonts
- 1; i
>= 0; --i
)
2520 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2523 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2525 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2526 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2527 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2528 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2529 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2530 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2531 tem
= build_font_name (fonts
+ i
);
2532 ASET (v
, 6, build_string (tem
));
2533 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2534 fonts
[i
].fields
[XLFD_ENCODING
]);
2535 ASET (v
, 7, build_string (tem
));
2538 result
= Fcons (v
, result
);
2543 remove_duplicates (result
);
2544 free_font_names (fonts
, nfonts
);
2550 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2552 "Return a list of available font families on FRAME.\n\
2553 If FRAME is omitted or nil, use the selected frame.\n\
2554 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2555 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2560 struct frame
*f
= check_x_frame (frame
);
2562 struct font_name
*fonts
;
2564 struct gcpro gcpro1
;
2565 int count
= specpdl_ptr
- specpdl
;
2568 /* Let's consider all fonts. Increase the limit for matching
2569 fonts until we have them all. */
2572 specbind (intern ("font-list-limit"), make_number (limit
));
2573 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2575 if (nfonts
== limit
)
2577 free_font_names (fonts
, nfonts
);
2586 for (i
= nfonts
- 1; i
>= 0; --i
)
2587 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2588 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2591 remove_duplicates (result
);
2592 free_font_names (fonts
, nfonts
);
2594 return unbind_to (count
, result
);
2598 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2599 "Return a list of the names of available fonts matching PATTERN.\n\
2600 If optional arguments FACE and FRAME are specified, return only fonts\n\
2601 the same size as FACE on FRAME.\n\
2602 PATTERN is a string, perhaps with wildcard characters;\n\
2603 the * character matches any substring, and\n\
2604 the ? character matches any single character.\n\
2605 PATTERN is case-insensitive.\n\
2606 FACE is a face name--a symbol.\n\
2608 The return value is a list of strings, suitable as arguments to\n\
2611 Fonts Emacs can't use may or may not be excluded\n\
2612 even if they match PATTERN and FACE.\n\
2613 The optional fourth argument MAXIMUM sets a limit on how many\n\
2614 fonts to match. The first MAXIMUM fonts are reported.\n\
2615 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2616 occupied by a character of a font. In that case, return only fonts\n\
2617 the WIDTH times as wide as FACE on FRAME.")
2618 (pattern
, face
, frame
, maximum
, width
)
2619 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2626 CHECK_STRING (pattern
, 0);
2632 CHECK_NATNUM (maximum
, 0);
2633 maxnames
= XINT (maximum
);
2637 CHECK_NUMBER (width
, 4);
2639 /* We can't simply call check_x_frame because this function may be
2640 called before any frame is created. */
2641 f
= frame_or_selected_frame (frame
, 2);
2642 if (!FRAME_WINDOW_P (f
))
2644 /* Perhaps we have not yet created any frame. */
2649 /* Determine the width standard for comparison with the fonts we find. */
2655 /* This is of limited utility since it works with character
2656 widths. Keep it for compatibility. --gerd. */
2657 int face_id
= lookup_named_face (f
, face
, 0);
2658 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2661 size
= FONT_WIDTH (face
->font
);
2663 size
= FONT_WIDTH (FRAME_FONT (f
));
2666 size
*= XINT (width
);
2670 Lisp_Object args
[2];
2672 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2674 /* We don't have to check fontsets. */
2676 args
[1] = list_fontsets (f
, pattern
, size
);
2677 return Fnconc (2, args
);
2681 #endif /* HAVE_WINDOW_SYSTEM */
2685 /***********************************************************************
2687 ***********************************************************************/
2689 /* Access face attributes of face FACE, a Lisp vector. */
2691 #define LFACE_FAMILY(LFACE) \
2692 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2693 #define LFACE_HEIGHT(LFACE) \
2694 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2695 #define LFACE_WEIGHT(LFACE) \
2696 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2697 #define LFACE_SLANT(LFACE) \
2698 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2699 #define LFACE_UNDERLINE(LFACE) \
2700 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2701 #define LFACE_INVERSE(LFACE) \
2702 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2703 #define LFACE_FOREGROUND(LFACE) \
2704 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2705 #define LFACE_BACKGROUND(LFACE) \
2706 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2707 #define LFACE_STIPPLE(LFACE) \
2708 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2709 #define LFACE_SWIDTH(LFACE) \
2710 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2711 #define LFACE_OVERLINE(LFACE) \
2712 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2713 #define LFACE_STRIKE_THROUGH(LFACE) \
2714 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2715 #define LFACE_BOX(LFACE) \
2716 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2717 #define LFACE_FONT(LFACE) \
2718 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2720 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2721 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2723 #define LFACEP(LFACE) \
2725 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2726 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2731 /* Check consistency of Lisp face attribute vector ATTRS. */
2734 check_lface_attrs (attrs
)
2737 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2738 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2739 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2740 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2741 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2742 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2743 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2744 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2745 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2746 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2747 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2748 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2749 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2750 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2751 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2752 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2753 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2754 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2755 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2756 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2757 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2758 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2759 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2760 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2761 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2762 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2763 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2764 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2765 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2766 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2767 #ifdef HAVE_WINDOW_SYSTEM
2768 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2769 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2770 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2771 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2772 || NILP (attrs
[LFACE_FONT_INDEX
])
2773 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2778 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2786 xassert (LFACEP (lface
));
2787 check_lface_attrs (XVECTOR (lface
)->contents
);
2791 #else /* GLYPH_DEBUG == 0 */
2793 #define check_lface_attrs(attrs) (void) 0
2794 #define check_lface(lface) (void) 0
2796 #endif /* GLYPH_DEBUG == 0 */
2799 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2800 to make it a symvol. If FACE_NAME is an alias for another face,
2801 return that face's name. */
2804 resolve_face_name (face_name
)
2805 Lisp_Object face_name
;
2807 Lisp_Object aliased
;
2809 if (STRINGP (face_name
))
2810 face_name
= intern (XSTRING (face_name
)->data
);
2814 aliased
= Fget (face_name
, Qface_alias
);
2818 face_name
= aliased
;
2825 /* Return the face definition of FACE_NAME on frame F. F null means
2826 return the global definition. FACE_NAME may be a string or a
2827 symbol (apparently Emacs 20.2 allows strings as face names in face
2828 text properties; ediff uses that). If FACE_NAME is an alias for
2829 another face, return that face's definition. If SIGNAL_P is
2830 non-zero, signal an error if FACE_NAME is not a valid face name.
2831 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2834 static INLINE Lisp_Object
2835 lface_from_face_name (f
, face_name
, signal_p
)
2837 Lisp_Object face_name
;
2842 face_name
= resolve_face_name (face_name
);
2845 lface
= assq_no_quit (face_name
, f
->face_alist
);
2847 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2850 lface
= XCDR (lface
);
2852 signal_error ("Invalid face", face_name
);
2854 check_lface (lface
);
2859 /* Get face attributes of face FACE_NAME from frame-local faces on
2860 frame F. Store the resulting attributes in ATTRS which must point
2861 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2862 is non-zero, signal an error if FACE_NAME does not name a face.
2863 Otherwise, value is zero if FACE_NAME is not a face. */
2866 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2868 Lisp_Object face_name
;
2875 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2878 bcopy (XVECTOR (lface
)->contents
, attrs
,
2879 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2889 /* Non-zero if all attributes in face attribute vector ATTRS are
2890 specified, i.e. are non-nil. */
2893 lface_fully_specified_p (attrs
)
2898 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2899 if (UNSPECIFIEDP (attrs
[i
]) && i
!= LFACE_FONT_INDEX
)
2902 return i
== LFACE_VECTOR_SIZE
;
2905 #ifdef HAVE_WINDOW_SYSTEM
2907 /* Set font-related attributes of Lisp face LFACE from the fullname of
2908 the font opened by FONTNAME. If FORCE_P is zero, set only
2909 unspecified attributes of LFACE. The exception is `font'
2910 attribute. It is set to FONTNAME as is regardless of FORCE_P.
2912 If FONTNAME is not available on frame F,
2913 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
2914 If the fullname is not in a valid XLFD format,
2915 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
2916 in LFACE and return 1.
2917 Otherwise, return 1. */
2920 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
2923 Lisp_Object fontname
;
2924 int force_p
, may_fail_p
;
2926 struct font_name font
;
2931 char *font_name
= XSTRING (fontname
)->data
;
2932 struct font_info
*font_info
;
2934 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
2935 fontset
= fs_query_fontset (fontname
, 0);
2937 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
2939 /* Check if FONT_NAME is surely available on the system. Usually
2940 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
2941 returns quickly. But, even if FONT_NAME is not yet cached,
2942 caching it now is not futail because we anyway load the font
2945 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
2955 font
.name
= STRDUPA (font_info
->full_name
);
2956 have_xlfd_p
= split_font_name (f
, &font
, 1);
2958 /* Set attributes only if unspecified, otherwise face defaults for
2959 new frames would never take effect. If we couldn't get a font
2960 name conforming to XLFD, set normal values. */
2962 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2967 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2968 + strlen (font
.fields
[XLFD_FOUNDRY
])
2970 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2971 font
.fields
[XLFD_FAMILY
]);
2972 val
= build_string (buffer
);
2975 val
= build_string ("*");
2976 LFACE_FAMILY (lface
) = val
;
2979 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2982 pt
= xlfd_point_size (f
, &font
);
2984 pt
= pixel_point_size (f
, font_info
->height
* 10);
2986 LFACE_HEIGHT (lface
) = make_number (pt
);
2989 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2990 LFACE_SWIDTH (lface
)
2991 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
2993 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2994 LFACE_WEIGHT (lface
)
2995 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
2997 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2999 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3001 LFACE_FONT (lface
) = fontname
;
3005 #endif /* HAVE_WINDOW_SYSTEM */
3008 /* Merge two Lisp face attribute vectors FROM and TO and store the
3009 resulting attributes in TO. Every non-nil attribute of FROM
3010 overrides the corresponding attribute of TO. */
3013 merge_face_vectors (from
, to
)
3014 Lisp_Object
*from
, *to
;
3017 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3018 if (!UNSPECIFIEDP (from
[i
]))
3023 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3024 is a face property, determine the resulting face attributes on
3025 frame F, and store them in TO. PROP may be a single face
3026 specification or a list of such specifications. Each face
3027 specification can be
3029 1. A symbol or string naming a Lisp face.
3031 2. A property list of the form (KEYWORD VALUE ...) where each
3032 KEYWORD is a face attribute name, and value is an appropriate value
3035 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3036 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3037 for compatibility with 20.2.
3039 Face specifications earlier in lists take precedence over later
3043 merge_face_vector_with_property (f
, to
, prop
)
3050 Lisp_Object first
= XCAR (prop
);
3052 if (EQ (first
, Qforeground_color
)
3053 || EQ (first
, Qbackground_color
))
3055 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3056 . COLOR). COLOR must be a string. */
3057 Lisp_Object color_name
= XCDR (prop
);
3058 Lisp_Object color
= first
;
3060 if (STRINGP (color_name
))
3062 if (EQ (color
, Qforeground_color
))
3063 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3065 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3068 add_to_log ("Invalid face color", color_name
, Qnil
);
3070 else if (SYMBOLP (first
)
3071 && *XSYMBOL (first
)->name
->data
== ':')
3073 /* Assume this is the property list form. */
3074 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3076 Lisp_Object keyword
= XCAR (prop
);
3077 Lisp_Object value
= XCAR (XCDR (prop
));
3079 if (EQ (keyword
, QCfamily
))
3081 if (STRINGP (value
))
3082 to
[LFACE_FAMILY_INDEX
] = value
;
3084 add_to_log ("Illegal face font family", value
, Qnil
);
3086 else if (EQ (keyword
, QCheight
))
3088 if (INTEGERP (value
))
3089 to
[LFACE_HEIGHT_INDEX
] = value
;
3091 add_to_log ("Illegal face font height", value
, Qnil
);
3093 else if (EQ (keyword
, QCweight
))
3096 && face_numeric_weight (value
) >= 0)
3097 to
[LFACE_WEIGHT_INDEX
] = value
;
3099 add_to_log ("Illegal face weight", value
, Qnil
);
3101 else if (EQ (keyword
, QCslant
))
3104 && face_numeric_slant (value
) >= 0)
3105 to
[LFACE_SLANT_INDEX
] = value
;
3107 add_to_log ("Illegal face slant", value
, Qnil
);
3109 else if (EQ (keyword
, QCunderline
))
3114 to
[LFACE_UNDERLINE_INDEX
] = value
;
3116 add_to_log ("Illegal face underline", value
, Qnil
);
3118 else if (EQ (keyword
, QCoverline
))
3123 to
[LFACE_OVERLINE_INDEX
] = value
;
3125 add_to_log ("Illegal face overline", value
, Qnil
);
3127 else if (EQ (keyword
, QCstrike_through
))
3132 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3134 add_to_log ("Illegal face strike-through", value
, Qnil
);
3136 else if (EQ (keyword
, QCbox
))
3139 value
= make_number (1);
3140 if (INTEGERP (value
)
3144 to
[LFACE_BOX_INDEX
] = value
;
3146 add_to_log ("Illegal face box", value
, Qnil
);
3148 else if (EQ (keyword
, QCinverse_video
)
3149 || EQ (keyword
, QCreverse_video
))
3151 if (EQ (value
, Qt
) || NILP (value
))
3152 to
[LFACE_INVERSE_INDEX
] = value
;
3154 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3156 else if (EQ (keyword
, QCforeground
))
3158 if (STRINGP (value
))
3159 to
[LFACE_FOREGROUND_INDEX
] = value
;
3161 add_to_log ("Illegal face foreground", value
, Qnil
);
3163 else if (EQ (keyword
, QCbackground
))
3165 if (STRINGP (value
))
3166 to
[LFACE_BACKGROUND_INDEX
] = value
;
3168 add_to_log ("Illegal face background", value
, Qnil
);
3170 else if (EQ (keyword
, QCstipple
))
3172 #ifdef HAVE_X_WINDOWS
3173 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3174 if (!NILP (pixmap_p
))
3175 to
[LFACE_STIPPLE_INDEX
] = value
;
3177 add_to_log ("Illegal face stipple", value
, Qnil
);
3180 else if (EQ (keyword
, QCwidth
))
3183 && face_numeric_swidth (value
) >= 0)
3184 to
[LFACE_SWIDTH_INDEX
] = value
;
3186 add_to_log ("Illegal face width", value
, Qnil
);
3189 add_to_log ("Invalid attribute %s in face property",
3192 prop
= XCDR (XCDR (prop
));
3197 /* This is a list of face specs. Specifications at the
3198 beginning of the list take precedence over later
3199 specifications, so we have to merge starting with the
3200 last specification. */
3201 Lisp_Object next
= XCDR (prop
);
3203 merge_face_vector_with_property (f
, to
, next
);
3204 merge_face_vector_with_property (f
, to
, first
);
3209 /* PROP ought to be a face name. */
3210 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3212 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3214 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3219 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3220 Sinternal_make_lisp_face
, 1, 2, 0,
3221 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3222 If FACE was not known as a face before, create a new one.\n\
3223 If optional argument FRAME is specified, make a frame-local face\n\
3224 for that frame. Otherwise operate on the global face definition.\n\
3225 Value is a vector of face attributes.")
3227 Lisp_Object face
, frame
;
3229 Lisp_Object global_lface
, lface
;
3233 CHECK_SYMBOL (face
, 0);
3234 global_lface
= lface_from_face_name (NULL
, face
, 0);
3238 CHECK_LIVE_FRAME (frame
, 1);
3240 lface
= lface_from_face_name (f
, face
, 0);
3243 f
= NULL
, lface
= Qnil
;
3245 /* Add a global definition if there is none. */
3246 if (NILP (global_lface
))
3248 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3250 XVECTOR (global_lface
)->contents
[0] = Qface
;
3251 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3252 Vface_new_frame_defaults
);
3254 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3255 face id to Lisp face is given by the vector lface_id_to_name.
3256 The mapping from Lisp face to Lisp face id is given by the
3257 property `face' of the Lisp face name. */
3258 if (next_lface_id
== lface_id_to_name_size
)
3260 int new_size
= max (50, 2 * lface_id_to_name_size
);
3261 int sz
= new_size
* sizeof *lface_id_to_name
;
3262 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3263 lface_id_to_name_size
= new_size
;
3266 lface_id_to_name
[next_lface_id
] = face
;
3267 Fput (face
, Qface
, make_number (next_lface_id
));
3271 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3272 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3274 /* Add a frame-local definition. */
3279 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3281 XVECTOR (lface
)->contents
[0] = Qface
;
3282 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3285 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3286 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3289 lface
= global_lface
;
3291 xassert (LFACEP (lface
));
3292 check_lface (lface
);
3297 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3298 Sinternal_lisp_face_p
, 1, 2, 0,
3299 "Return non-nil if FACE names a face.\n\
3300 If optional second parameter FRAME is non-nil, check for the\n\
3301 existence of a frame-local face with name FACE on that frame.\n\
3302 Otherwise check for the existence of a global face.")
3304 Lisp_Object face
, frame
;
3310 CHECK_LIVE_FRAME (frame
, 1);
3311 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3314 lface
= lface_from_face_name (NULL
, face
, 0);
3320 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3321 Sinternal_copy_lisp_face
, 4, 4, 0,
3322 "Copy face FROM to TO.\n\
3323 If FRAME it t, copy the global face definition of FROM to the\n\
3324 global face definition of TO. Otherwise, copy the frame-local\n\
3325 definition of FROM on FRAME to the frame-local definition of TO\n\
3326 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3329 (from
, to
, frame
, new_frame
)
3330 Lisp_Object from
, to
, frame
, new_frame
;
3332 Lisp_Object lface
, copy
;
3334 CHECK_SYMBOL (from
, 0);
3335 CHECK_SYMBOL (to
, 1);
3336 if (NILP (new_frame
))
3341 /* Copy global definition of FROM. We don't make copies of
3342 strings etc. because 20.2 didn't do it either. */
3343 lface
= lface_from_face_name (NULL
, from
, 1);
3344 copy
= Finternal_make_lisp_face (to
, Qnil
);
3348 /* Copy frame-local definition of FROM. */
3349 CHECK_LIVE_FRAME (frame
, 2);
3350 CHECK_LIVE_FRAME (new_frame
, 3);
3351 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3352 copy
= Finternal_make_lisp_face (to
, new_frame
);
3355 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3356 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3362 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3363 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3364 "Set attribute ATTR of FACE to VALUE.\n\
3365 If optional argument FRAME is given, set the face attribute of face FACE\n\
3366 on that frame. If FRAME is t, set the attribute of the default for face\n\
3367 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3369 (face
, attr
, value
, frame
)
3370 Lisp_Object face
, attr
, value
, frame
;
3373 Lisp_Object old_value
= Qnil
;
3374 /* Set 1 if ATTR is QCfont. */
3375 int font_attr_p
= 0;
3376 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3377 int font_related_attr_p
= 0;
3379 CHECK_SYMBOL (face
, 0);
3380 CHECK_SYMBOL (attr
, 1);
3382 face
= resolve_face_name (face
);
3384 /* Set lface to the Lisp attribute vector of FACE. */
3386 lface
= lface_from_face_name (NULL
, face
, 1);
3390 frame
= selected_frame
;
3392 CHECK_LIVE_FRAME (frame
, 3);
3393 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3395 /* If a frame-local face doesn't exist yet, create one. */
3397 lface
= Finternal_make_lisp_face (face
, frame
);
3400 if (EQ (attr
, QCfamily
))
3402 if (!UNSPECIFIEDP (value
))
3404 CHECK_STRING (value
, 3);
3405 if (XSTRING (value
)->size
== 0)
3406 signal_error ("Invalid face family", value
);
3408 old_value
= LFACE_FAMILY (lface
);
3409 LFACE_FAMILY (lface
) = value
;
3410 font_related_attr_p
= 1;
3412 else if (EQ (attr
, QCheight
))
3414 if (!UNSPECIFIEDP (value
))
3416 CHECK_NUMBER (value
, 3);
3417 if (XINT (value
) <= 0)
3418 signal_error ("Invalid face height", value
);
3420 old_value
= LFACE_HEIGHT (lface
);
3421 LFACE_HEIGHT (lface
) = value
;
3422 font_related_attr_p
= 1;
3424 else if (EQ (attr
, QCweight
))
3426 if (!UNSPECIFIEDP (value
))
3428 CHECK_SYMBOL (value
, 3);
3429 if (face_numeric_weight (value
) < 0)
3430 signal_error ("Invalid face weight", value
);
3432 old_value
= LFACE_WEIGHT (lface
);
3433 LFACE_WEIGHT (lface
) = value
;
3434 font_related_attr_p
= 1;
3436 else if (EQ (attr
, QCslant
))
3438 if (!UNSPECIFIEDP (value
))
3440 CHECK_SYMBOL (value
, 3);
3441 if (face_numeric_slant (value
) < 0)
3442 signal_error ("Invalid face slant", value
);
3444 old_value
= LFACE_SLANT (lface
);
3445 LFACE_SLANT (lface
) = value
;
3446 font_related_attr_p
= 1;
3448 else if (EQ (attr
, QCunderline
))
3450 if (!UNSPECIFIEDP (value
))
3451 if ((SYMBOLP (value
)
3453 && !EQ (value
, Qnil
))
3454 /* Underline color. */
3456 && XSTRING (value
)->size
== 0))
3457 signal_error ("Invalid face underline", value
);
3459 old_value
= LFACE_UNDERLINE (lface
);
3460 LFACE_UNDERLINE (lface
) = value
;
3462 else if (EQ (attr
, QCoverline
))
3464 if (!UNSPECIFIEDP (value
))
3465 if ((SYMBOLP (value
)
3467 && !EQ (value
, Qnil
))
3468 /* Overline color. */
3470 && XSTRING (value
)->size
== 0))
3471 signal_error ("Invalid face overline", value
);
3473 old_value
= LFACE_OVERLINE (lface
);
3474 LFACE_OVERLINE (lface
) = value
;
3476 else if (EQ (attr
, QCstrike_through
))
3478 if (!UNSPECIFIEDP (value
))
3479 if ((SYMBOLP (value
)
3481 && !EQ (value
, Qnil
))
3482 /* Strike-through color. */
3484 && XSTRING (value
)->size
== 0))
3485 signal_error ("Invalid face strike-through", value
);
3487 old_value
= LFACE_STRIKE_THROUGH (lface
);
3488 LFACE_STRIKE_THROUGH (lface
) = value
;
3490 else if (EQ (attr
, QCbox
))
3494 /* Allow t meaning a simple box of width 1 in foreground color
3497 value
= make_number (1);
3499 if (UNSPECIFIEDP (value
))
3501 else if (NILP (value
))
3503 else if (INTEGERP (value
))
3504 valid_p
= XINT (value
) > 0;
3505 else if (STRINGP (value
))
3506 valid_p
= XSTRING (value
)->size
> 0;
3507 else if (CONSP (value
))
3523 if (EQ (k
, QCline_width
))
3525 if (!INTEGERP (v
) || XINT (v
) <= 0)
3528 else if (EQ (k
, QCcolor
))
3530 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3533 else if (EQ (k
, QCstyle
))
3535 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3542 valid_p
= NILP (tem
);
3548 signal_error ("Invalid face box", value
);
3550 old_value
= LFACE_BOX (lface
);
3551 LFACE_BOX (lface
) = value
;
3553 else if (EQ (attr
, QCinverse_video
)
3554 || EQ (attr
, QCreverse_video
))
3556 if (!UNSPECIFIEDP (value
))
3558 CHECK_SYMBOL (value
, 3);
3559 if (!EQ (value
, Qt
) && !NILP (value
))
3560 signal_error ("Invalid inverse-video face attribute value", value
);
3562 old_value
= LFACE_INVERSE (lface
);
3563 LFACE_INVERSE (lface
) = value
;
3565 else if (EQ (attr
, QCforeground
))
3567 if (!UNSPECIFIEDP (value
))
3569 /* Don't check for valid color names here because it depends
3570 on the frame (display) whether the color will be valid
3571 when the face is realized. */
3572 CHECK_STRING (value
, 3);
3573 if (XSTRING (value
)->size
== 0)
3574 signal_error ("Empty foreground color value", value
);
3576 old_value
= LFACE_FOREGROUND (lface
);
3577 LFACE_FOREGROUND (lface
) = value
;
3579 else if (EQ (attr
, QCbackground
))
3581 if (!UNSPECIFIEDP (value
))
3583 /* Don't check for valid color names here because it depends
3584 on the frame (display) whether the color will be valid
3585 when the face is realized. */
3586 CHECK_STRING (value
, 3);
3587 if (XSTRING (value
)->size
== 0)
3588 signal_error ("Empty background color value", value
);
3590 old_value
= LFACE_BACKGROUND (lface
);
3591 LFACE_BACKGROUND (lface
) = value
;
3593 else if (EQ (attr
, QCstipple
))
3595 #ifdef HAVE_X_WINDOWS
3596 if (!UNSPECIFIEDP (value
)
3598 && NILP (Fbitmap_spec_p (value
)))
3599 signal_error ("Invalid stipple attribute", value
);
3600 old_value
= LFACE_STIPPLE (lface
);
3601 LFACE_STIPPLE (lface
) = value
;
3602 #endif /* HAVE_X_WINDOWS */
3604 else if (EQ (attr
, QCwidth
))
3606 if (!UNSPECIFIEDP (value
))
3608 CHECK_SYMBOL (value
, 3);
3609 if (face_numeric_swidth (value
) < 0)
3610 signal_error ("Invalid face width", value
);
3612 old_value
= LFACE_SWIDTH (lface
);
3613 LFACE_SWIDTH (lface
) = value
;
3614 font_related_attr_p
= 1;
3616 else if (EQ (attr
, QCfont
))
3618 #ifdef HAVE_WINDOW_SYSTEM
3619 /* Set font-related attributes of the Lisp face from an
3624 CHECK_STRING (value
, 3);
3626 f
= SELECTED_FRAME ();
3628 f
= check_x_frame (frame
);
3630 /* VALUE may be a fontset name or an alias of fontset. In such
3631 a case, use the base fontset name. */
3632 tmp
= Fquery_fontset (value
, Qnil
);
3636 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3637 signal_error ("Invalid font or fontset name", value
);
3640 #endif /* HAVE_WINDOW_SYSTEM */
3642 else if (EQ (attr
, QCbold
))
3644 old_value
= LFACE_WEIGHT (lface
);
3645 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3646 font_related_attr_p
= 1;
3648 else if (EQ (attr
, QCitalic
))
3650 old_value
= LFACE_SLANT (lface
);
3651 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3652 font_related_attr_p
= 1;
3655 signal_error ("Invalid face attribute name", attr
);
3657 if (font_related_attr_p
3658 && !UNSPECIFIEDP (value
))
3659 /* If a font-related attribute other than QCfont is specified, the
3660 original `font' attribute nor that of default face is useless
3661 to determine a new font. Thus, we set it to nil so that font
3662 selection mechanism doesn't use it. */
3663 LFACE_FONT (lface
) = Qnil
;
3665 /* Changing a named face means that all realized faces depending on
3666 that face are invalid. Since we cannot tell which realized faces
3667 depend on the face, make sure they are all removed. This is done
3668 by incrementing face_change_count. The next call to
3669 init_iterator will then free realized faces. */
3671 && (EQ (attr
, QCfont
)
3672 || NILP (Fequal (old_value
, value
))))
3674 ++face_change_count
;
3675 ++windows_or_buffers_changed
;
3678 #ifdef HAVE_WINDOW_SYSTEM
3681 && !UNSPECIFIEDP (value
)
3682 && NILP (Fequal (old_value
, value
)))
3688 if (EQ (face
, Qdefault
))
3690 /* Changed font-related attributes of the `default' face are
3691 reflected in changed `font' frame parameters. */
3692 if ((font_related_attr_p
|| font_attr_p
)
3693 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3694 set_font_frame_param (frame
, lface
);
3695 else if (EQ (attr
, QCforeground
))
3696 param
= Qforeground_color
;
3697 else if (EQ (attr
, QCbackground
))
3698 param
= Qbackground_color
;
3701 else if (EQ (face
, Qscroll_bar
))
3703 /* Changing the colors of `scroll-bar' sets frame parameters
3704 `scroll-bar-foreground' and `scroll-bar-background'. */
3705 if (EQ (attr
, QCforeground
))
3706 param
= Qscroll_bar_foreground
;
3707 else if (EQ (attr
, QCbackground
))
3708 param
= Qscroll_bar_background
;
3711 else if (EQ (face
, Qborder
))
3713 /* Changing background color of `border' sets frame parameter
3715 if (EQ (attr
, QCbackground
))
3716 param
= Qborder_color
;
3718 else if (EQ (face
, Qcursor
))
3720 /* Changing background color of `cursor' sets frame parameter
3722 if (EQ (attr
, QCbackground
))
3723 param
= Qcursor_color
;
3725 else if (EQ (face
, Qmouse
))
3727 /* Changing background color of `mouse' sets frame parameter
3729 if (EQ (attr
, QCbackground
))
3730 param
= Qmouse_color
;
3734 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3737 #endif /* HAVE_WINDOW_SYSTEM */
3743 #ifdef HAVE_WINDOW_SYSTEM
3745 /* Set the `font' frame parameter of FRAME determined from `default'
3746 face attributes LFACE. If a face or fontset name is explicitely
3747 specfied in LFACE, use it as is. Otherwise, determine a font name
3748 from the other font-related atrributes of LFACE. In that case, if
3749 there's no matching font, signals an error. */
3752 set_font_frame_param (frame
, lface
)
3753 Lisp_Object frame
, lface
;
3755 struct frame
*f
= XFRAME (frame
);
3756 Lisp_Object font_name
;
3759 if (STRINGP (LFACE_FONT (lface
)))
3760 font_name
= LFACE_FONT (lface
);
3763 /* Choose a font name that reflects LFACE's attributes and has
3764 the registry and encoding pattern specified in the default
3765 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
3766 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
3768 error ("No font matches the specified attribute");
3769 font_name
= build_string (font
);
3772 store_frame_param (f
, Qfont
, font_name
);
3776 /* Update the corresponding face when frame parameter PARAM on frame F
3777 has been assigned the value NEW_VALUE. */
3780 update_face_from_frame_parameter (f
, param
, new_value
)
3782 Lisp_Object param
, new_value
;
3786 /* If there are no faces yet, give up. This is the case when called
3787 from Fx_create_frame, and we do the necessary things later in
3788 face-set-after-frame-defaults. */
3789 if (NILP (f
->face_alist
))
3792 if (EQ (param
, Qforeground_color
))
3794 lface
= lface_from_face_name (f
, Qdefault
, 1);
3795 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3796 ? new_value
: Qunspecified
);
3797 realize_basic_faces (f
);
3799 else if (EQ (param
, Qbackground_color
))
3803 /* Changing the background color might change the background
3804 mode, so that we have to load new defface specs. Call
3805 frame-update-face-colors to do that. */
3806 XSETFRAME (frame
, f
);
3807 call1 (Qframe_update_face_colors
, frame
);
3809 lface
= lface_from_face_name (f
, Qdefault
, 1);
3810 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3811 ? new_value
: Qunspecified
);
3812 realize_basic_faces (f
);
3814 if (EQ (param
, Qborder_color
))
3816 lface
= lface_from_face_name (f
, Qborder
, 1);
3817 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3818 ? new_value
: Qunspecified
);
3820 else if (EQ (param
, Qcursor_color
))
3822 lface
= lface_from_face_name (f
, Qcursor
, 1);
3823 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3824 ? new_value
: Qunspecified
);
3826 else if (EQ (param
, Qmouse_color
))
3828 lface
= lface_from_face_name (f
, Qmouse
, 1);
3829 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3830 ? new_value
: Qunspecified
);
3835 /* Get the value of X resource RESOURCE, class CLASS for the display
3836 of frame FRAME. This is here because ordinary `x-get-resource'
3837 doesn't take a frame argument. */
3839 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3840 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3841 (resource
, class, frame
)
3842 Lisp_Object resource
, class, frame
;
3844 Lisp_Object value
= Qnil
;
3846 CHECK_STRING (resource
, 0);
3847 CHECK_STRING (class, 1);
3848 CHECK_LIVE_FRAME (frame
, 2);
3850 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3851 resource
, class, Qnil
, Qnil
);
3858 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3859 If VALUE is "on" or "true", return t. If VALUE is "off" or
3860 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3861 error; if SIGNAL_P is zero, return 0. */
3864 face_boolean_x_resource_value (value
, signal_p
)
3868 Lisp_Object result
= make_number (0);
3870 xassert (STRINGP (value
));
3872 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3873 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3875 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3876 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3878 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3879 result
= Qunspecified
;
3881 signal_error ("Invalid face attribute value from X resource", value
);
3887 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3888 Finternal_set_lisp_face_attribute_from_resource
,
3889 Sinternal_set_lisp_face_attribute_from_resource
,
3891 (face
, attr
, value
, frame
)
3892 Lisp_Object face
, attr
, value
, frame
;
3894 CHECK_SYMBOL (face
, 0);
3895 CHECK_SYMBOL (attr
, 1);
3896 CHECK_STRING (value
, 2);
3898 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3899 value
= Qunspecified
;
3900 else if (EQ (attr
, QCheight
))
3902 value
= Fstring_to_number (value
, make_number (10));
3903 if (XINT (value
) <= 0)
3904 signal_error ("Invalid face height from X resource", value
);
3906 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3907 value
= face_boolean_x_resource_value (value
, 1);
3908 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3909 value
= intern (XSTRING (value
)->data
);
3910 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3911 value
= face_boolean_x_resource_value (value
, 1);
3912 else if (EQ (attr
, QCunderline
)
3913 || EQ (attr
, QCoverline
)
3914 || EQ (attr
, QCstrike_through
)
3915 || EQ (attr
, QCbox
))
3917 Lisp_Object boolean_value
;
3919 /* If the result of face_boolean_x_resource_value is t or nil,
3920 VALUE does NOT specify a color. */
3921 boolean_value
= face_boolean_x_resource_value (value
, 0);
3922 if (SYMBOLP (boolean_value
))
3923 value
= boolean_value
;
3926 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3929 #endif /* HAVE_WINDOW_SYSTEM */
3932 #ifdef HAVE_X_WINDOWS
3933 /***********************************************************************
3935 ***********************************************************************/
3937 #ifdef USE_X_TOOLKIT
3939 /* Structure used to pass X resources to functions called via
3940 XtApplyToWidgets. */
3951 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3952 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3955 /* Set widget W's X resources from P which points to an x_resources
3956 structure. If W is a cascade button, apply resources to W's
3960 xm_apply_resources (w
, p
)
3965 struct x_resources
*res
= (struct x_resources
*) p
;
3967 XtSetValues (w
, res
->av
, res
->ac
);
3968 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3971 XtSetValues (submenu
, res
->av
, res
->ac
);
3972 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3977 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3978 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3981 1. Setting the XmNfontList resource leads to an infinite loop
3982 somewhere in LessTif. */
3985 xm_set_menu_resources_from_menu_face (f
, widget
)
3995 lface
= lface_from_face_name (f
, Qmenu
, 1);
3996 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3998 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4000 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4004 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4006 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4010 /* If any font-related attribute of `menu' is set, set the font. */
4012 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4013 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4014 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4015 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4016 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4018 #if 0 /* Setting the font leads to an infinite loop somewhere
4019 in LessTif during geometry computation. */
4021 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4022 fl
= XmFontListAppendEntry (NULL
, fe
);
4023 XtSetArg (av
[ac
], XmNfontList
, fl
);
4028 xassert (ac
<= sizeof av
/ sizeof *av
);
4032 struct x_resources res
;
4034 XtSetValues (widget
, av
, ac
);
4035 res
.av
= av
, res
.ac
= ac
;
4036 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4038 XmFontListFree (fl
);
4043 #endif /* USE_MOTIF */
4047 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4048 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4051 /* Set widget W's resources from P which points to an x_resources
4055 xl_apply_resources (widget
, p
)
4059 struct x_resources
*res
= (struct x_resources
*) p
;
4060 XtSetValues (widget
, res
->av
, res
->ac
);
4064 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4065 This is the Lucid version. */
4068 xl_set_menu_resources_from_menu_face (f
, widget
)
4077 lface
= lface_from_face_name (f
, Qmenu
, 1);
4078 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4080 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4082 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4086 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4088 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4093 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4094 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4095 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4096 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4097 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4099 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4105 struct x_resources res
;
4107 XtSetValues (widget
, av
, ac
);
4109 /* We must do children here in case we're handling a pop-up menu
4110 in which case WIDGET is a popup shell. XtApplyToWidgets
4111 is a function from lwlib. */
4112 res
.av
= av
, res
.ac
= ac
;
4113 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4117 #endif /* USE_LUCID */
4120 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4123 x_set_menu_resources_from_menu_face (f
, widget
)
4127 /* Realized faces may have been removed on frame F, e.g. because of
4128 face attribute changes. Recompute them, if necessary, since we
4129 will need the `menu' face. */
4130 if (f
->face_cache
->used
== 0)
4131 recompute_basic_faces (f
);
4134 xl_set_menu_resources_from_menu_face (f
, widget
);
4137 xm_set_menu_resources_from_menu_face (f
, widget
);
4141 #endif /* USE_X_TOOLKIT */
4143 #endif /* HAVE_X_WINDOWS */
4147 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4148 Sinternal_get_lisp_face_attribute
,
4150 "Return face attribute KEYWORD of face SYMBOL.\n\
4151 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4152 face attribute name, signal an error.\n\
4153 If the optional argument FRAME is given, report on face FACE in that\n\
4154 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4155 frames). If FRAME is omitted or nil, use the selected frame.")
4156 (symbol
, keyword
, frame
)
4157 Lisp_Object symbol
, keyword
, frame
;
4159 Lisp_Object lface
, value
= Qnil
;
4161 CHECK_SYMBOL (symbol
, 0);
4162 CHECK_SYMBOL (keyword
, 1);
4165 lface
= lface_from_face_name (NULL
, symbol
, 1);
4169 frame
= selected_frame
;
4170 CHECK_LIVE_FRAME (frame
, 2);
4171 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4174 if (EQ (keyword
, QCfamily
))
4175 value
= LFACE_FAMILY (lface
);
4176 else if (EQ (keyword
, QCheight
))
4177 value
= LFACE_HEIGHT (lface
);
4178 else if (EQ (keyword
, QCweight
))
4179 value
= LFACE_WEIGHT (lface
);
4180 else if (EQ (keyword
, QCslant
))
4181 value
= LFACE_SLANT (lface
);
4182 else if (EQ (keyword
, QCunderline
))
4183 value
= LFACE_UNDERLINE (lface
);
4184 else if (EQ (keyword
, QCoverline
))
4185 value
= LFACE_OVERLINE (lface
);
4186 else if (EQ (keyword
, QCstrike_through
))
4187 value
= LFACE_STRIKE_THROUGH (lface
);
4188 else if (EQ (keyword
, QCbox
))
4189 value
= LFACE_BOX (lface
);
4190 else if (EQ (keyword
, QCinverse_video
)
4191 || EQ (keyword
, QCreverse_video
))
4192 value
= LFACE_INVERSE (lface
);
4193 else if (EQ (keyword
, QCforeground
))
4194 value
= LFACE_FOREGROUND (lface
);
4195 else if (EQ (keyword
, QCbackground
))
4196 value
= LFACE_BACKGROUND (lface
);
4197 else if (EQ (keyword
, QCstipple
))
4198 value
= LFACE_STIPPLE (lface
);
4199 else if (EQ (keyword
, QCwidth
))
4200 value
= LFACE_SWIDTH (lface
);
4201 else if (EQ (keyword
, QCfont
))
4202 value
= LFACE_FONT (lface
);
4204 signal_error ("Invalid face attribute name", keyword
);
4210 DEFUN ("internal-lisp-face-attribute-values",
4211 Finternal_lisp_face_attribute_values
,
4212 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4213 "Return a list of valid discrete values for face attribute ATTR.\n\
4214 Value is nil if ATTR doesn't have a discrete set of valid values.")
4218 Lisp_Object result
= Qnil
;
4220 CHECK_SYMBOL (attr
, 0);
4222 if (EQ (attr
, QCweight
)
4223 || EQ (attr
, QCslant
)
4224 || EQ (attr
, QCwidth
))
4226 /* Extract permissible symbols from tables. */
4227 struct table_entry
*table
;
4230 if (EQ (attr
, QCweight
))
4231 table
= weight_table
, dim
= DIM (weight_table
);
4232 else if (EQ (attr
, QCslant
))
4233 table
= slant_table
, dim
= DIM (slant_table
);
4235 table
= swidth_table
, dim
= DIM (swidth_table
);
4237 for (i
= 0; i
< dim
; ++i
)
4239 Lisp_Object symbol
= *table
[i
].symbol
;
4240 Lisp_Object tail
= result
;
4243 && !EQ (XCAR (tail
), symbol
))
4247 result
= Fcons (symbol
, result
);
4250 else if (EQ (attr
, QCunderline
))
4251 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4252 else if (EQ (attr
, QCoverline
))
4253 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4254 else if (EQ (attr
, QCstrike_through
))
4255 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4256 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4257 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4263 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4264 Sinternal_merge_in_global_face
, 2, 2, 0,
4265 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4267 Lisp_Object face
, frame
;
4269 Lisp_Object global_lface
, local_lface
;
4270 CHECK_LIVE_FRAME (frame
, 1);
4271 global_lface
= lface_from_face_name (NULL
, face
, 1);
4272 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4273 if (NILP (local_lface
))
4274 local_lface
= Finternal_make_lisp_face (face
, frame
);
4275 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4276 XVECTOR (local_lface
)->contents
);
4281 /* The following function is implemented for compatibility with 20.2.
4282 The function is used in x-resolve-fonts when it is asked to
4283 return fonts with the same size as the font of a face. This is
4284 done in fontset.el. */
4286 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4287 "Return the font name of face FACE, or nil if it is unspecified.\n\
4288 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4289 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4290 The font default for a face is either nil, or a list\n\
4291 of the form (bold), (italic) or (bold italic).\n\
4292 If FRAME is omitted or nil, use the selected frame.")
4294 Lisp_Object face
, frame
;
4298 Lisp_Object result
= Qnil
;
4299 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4301 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4302 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4303 result
= Fcons (Qbold
, result
);
4305 if (!NILP (LFACE_SLANT (lface
))
4306 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4307 result
= Fcons (Qitalic
, result
);
4313 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4314 int face_id
= lookup_named_face (f
, face
, 0);
4315 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4316 return build_string (face
->font_name
);
4321 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4322 all attributes are `equal'. Tries to be fast because this function
4323 is called quite often. */
4326 lface_equal_p (v1
, v2
)
4327 Lisp_Object
*v1
, *v2
;
4331 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4333 Lisp_Object a
= v1
[i
];
4334 Lisp_Object b
= v2
[i
];
4336 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4337 and the other is specified. */
4338 equal_p
= XTYPE (a
) == XTYPE (b
);
4347 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4348 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4349 XSTRING (a
)->size
) == 0);
4358 equal_p
= !NILP (Fequal (a
, b
));
4368 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4369 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4370 "True if FACE1 and FACE2 are equal.\n\
4371 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4372 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4373 If FRAME is omitted or nil, use the selected frame.")
4374 (face1
, face2
, frame
)
4375 Lisp_Object face1
, face2
, frame
;
4379 Lisp_Object lface1
, lface2
;
4384 /* Don't use check_x_frame here because this function is called
4385 before X frames exist. At that time, if FRAME is nil,
4386 selected_frame will be used which is the frame dumped with
4387 Emacs. That frame is not an X frame. */
4388 f
= frame_or_selected_frame (frame
, 2);
4390 lface1
= lface_from_face_name (NULL
, face1
, 1);
4391 lface2
= lface_from_face_name (NULL
, face2
, 1);
4392 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4393 XVECTOR (lface2
)->contents
);
4394 return equal_p
? Qt
: Qnil
;
4398 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4399 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4400 "True if FACE has no attribute specified.\n\
4401 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4402 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4403 If FRAME is omitted or nil, use the selected frame.")
4405 Lisp_Object face
, frame
;
4412 frame
= selected_frame
;
4413 CHECK_LIVE_FRAME (frame
, 0);
4417 lface
= lface_from_face_name (NULL
, face
, 1);
4419 lface
= lface_from_face_name (f
, face
, 1);
4421 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4422 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4425 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4429 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4431 "Return an alist of frame-local faces defined on FRAME.\n\
4432 For internal use only.")
4436 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4437 return f
->face_alist
;
4441 /* Return a hash code for Lisp string STRING with case ignored. Used
4442 below in computing a hash value for a Lisp face. */
4444 static INLINE
unsigned
4445 hash_string_case_insensitive (string
)
4450 xassert (STRINGP (string
));
4451 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4452 hash
= (hash
<< 1) ^ tolower (*s
);
4457 /* Return a hash code for face attribute vector V. */
4459 static INLINE
unsigned
4463 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4464 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4465 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4466 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4467 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4468 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4469 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4473 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4474 considering charsets/registries). They do if they specify the same
4475 family, point size, weight, width, slant, and fontset. Both LFACE1
4476 and LFACE2 must be fully-specified. */
4479 lface_same_font_attributes_p (lface1
, lface2
)
4480 Lisp_Object
*lface1
, *lface2
;
4482 xassert (lface_fully_specified_p (lface1
)
4483 && lface_fully_specified_p (lface2
));
4484 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4485 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4486 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4487 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4488 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4489 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4490 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4491 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4492 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4493 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4494 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4495 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4500 /***********************************************************************
4502 ***********************************************************************/
4504 /* Allocate and return a new realized face for Lisp face attribute
4507 static struct face
*
4508 make_realized_face (attr
)
4511 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4512 bzero (face
, sizeof *face
);
4513 face
->ascii_face
= face
;
4514 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4519 /* Free realized face FACE, including its X resources. FACE may
4523 free_realized_face (f
, face
)
4529 #ifdef HAVE_WINDOW_SYSTEM
4530 if (FRAME_WINDOW_P (f
))
4532 /* Free fontset of FACE if it is ASCII face. */
4533 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4534 free_face_fontset (f
, face
);
4537 x_free_gc (f
, face
->gc
);
4541 free_face_colors (f
, face
);
4542 x_destroy_bitmap (f
, face
->stipple
);
4544 #endif /* HAVE_WINDOW_SYSTEM */
4551 /* Prepare face FACE for subsequent display on frame F. This
4552 allocated GCs if they haven't been allocated yet or have been freed
4553 by clearing the face cache. */
4556 prepare_face_for_display (f
, face
)
4560 #ifdef HAVE_WINDOW_SYSTEM
4561 xassert (FRAME_WINDOW_P (f
));
4566 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4568 xgcv
.foreground
= face
->foreground
;
4569 xgcv
.background
= face
->background
;
4570 #ifdef HAVE_X_WINDOWS
4571 xgcv
.graphics_exposures
= False
;
4573 /* The font of FACE may be null if we couldn't load it. */
4576 #ifdef HAVE_X_WINDOWS
4577 xgcv
.font
= face
->font
->fid
;
4580 xgcv
.font
= face
->font
;
4586 #ifdef HAVE_X_WINDOWS
4589 xgcv
.fill_style
= FillOpaqueStippled
;
4590 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4591 mask
|= GCFillStyle
| GCStipple
;
4594 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4597 #endif /* HAVE_WINDOW_SYSTEM */
4601 /***********************************************************************
4603 ***********************************************************************/
4605 /* Return a new face cache for frame F. */
4607 static struct face_cache
*
4611 struct face_cache
*c
;
4614 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4615 bzero (c
, sizeof *c
);
4616 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4617 c
->buckets
= (struct face
**) xmalloc (size
);
4618 bzero (c
->buckets
, size
);
4620 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4626 /* Clear out all graphics contexts for all realized faces, except for
4627 the basic faces. This should be done from time to time just to avoid
4628 keeping too many graphics contexts that are no longer needed. */
4632 struct face_cache
*c
;
4634 if (c
&& FRAME_WINDOW_P (c
->f
))
4636 #ifdef HAVE_WINDOW_SYSTEM
4638 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4640 struct face
*face
= c
->faces_by_id
[i
];
4641 if (face
&& face
->gc
)
4643 x_free_gc (c
->f
, face
->gc
);
4647 #endif /* HAVE_WINDOW_SYSTEM */
4652 /* Free all realized faces in face cache C, including basic faces. C
4653 may be null. If faces are freed, make sure the frame's current
4654 matrix is marked invalid, so that a display caused by an expose
4655 event doesn't try to use faces we destroyed. */
4658 free_realized_faces (c
)
4659 struct face_cache
*c
;
4664 struct frame
*f
= c
->f
;
4666 for (i
= 0; i
< c
->used
; ++i
)
4668 free_realized_face (f
, c
->faces_by_id
[i
]);
4669 c
->faces_by_id
[i
] = NULL
;
4673 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4674 bzero (c
->buckets
, size
);
4676 /* Must do a thorough redisplay the next time. Mark current
4677 matrices as invalid because they will reference faces freed
4678 above. This function is also called when a frame is
4679 destroyed. In this case, the root window of F is nil. */
4680 if (WINDOWP (f
->root_window
))
4682 clear_current_matrices (f
);
4683 ++windows_or_buffers_changed
;
4689 /* Free all faces realized for multibyte characters on frame F that
4693 free_realized_multibyte_face (f
, fontset
)
4697 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4701 for (i
= 0; i
< cache
->used
; i
++)
4703 face
= cache
->faces_by_id
[i
];
4705 && face
!= face
->ascii_face
4706 && face
->fontset
== fontset
)
4708 uncache_face (cache
, face
);
4709 free_realized_face (f
, face
);
4712 if (WINDOWP (f
->root_window
))
4714 clear_current_matrices (f
);
4715 ++windows_or_buffers_changed
;
4720 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4721 This is done after attributes of a named face have been changed,
4722 because we can't tell which realized faces depend on that face. */
4725 free_all_realized_faces (frame
)
4731 FOR_EACH_FRAME (rest
, frame
)
4732 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4735 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4739 /* Free face cache C and faces in it, including their X resources. */
4743 struct face_cache
*c
;
4747 free_realized_faces (c
);
4749 xfree (c
->faces_by_id
);
4755 /* Cache realized face FACE in face cache C. HASH is the hash value
4756 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4757 collision list of the face hash table of C. This is done because
4758 otherwise lookup_face would find FACE for every character, even if
4759 faces with the same attributes but for specific characters exist. */
4762 cache_face (c
, face
, hash
)
4763 struct face_cache
*c
;
4767 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4771 if (face
->fontset
>= 0)
4773 struct face
*last
= c
->buckets
[i
];
4784 c
->buckets
[i
] = face
;
4785 face
->prev
= face
->next
= NULL
;
4791 face
->next
= c
->buckets
[i
];
4793 face
->next
->prev
= face
;
4794 c
->buckets
[i
] = face
;
4797 /* Find a free slot in C->faces_by_id and use the index of the free
4798 slot as FACE->id. */
4799 for (i
= 0; i
< c
->used
; ++i
)
4800 if (c
->faces_by_id
[i
] == NULL
)
4804 /* Maybe enlarge C->faces_by_id. */
4805 if (i
== c
->used
&& c
->used
== c
->size
)
4807 int new_size
= 2 * c
->size
;
4808 int sz
= new_size
* sizeof *c
->faces_by_id
;
4809 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4814 /* Check that FACE got a unique id. */
4819 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4820 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4826 #endif /* GLYPH_DEBUG */
4828 c
->faces_by_id
[i
] = face
;
4834 /* Remove face FACE from cache C. */
4837 uncache_face (c
, face
)
4838 struct face_cache
*c
;
4841 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4844 face
->prev
->next
= face
->next
;
4846 c
->buckets
[i
] = face
->next
;
4849 face
->next
->prev
= face
->prev
;
4851 c
->faces_by_id
[face
->id
] = NULL
;
4852 if (face
->id
== c
->used
)
4857 /* Look up a realized face with face attributes ATTR in the face cache
4858 of frame F. The face will be used to display character C. Value
4859 is the ID of the face found. If no suitable face is found, realize
4860 a new one. In that case, if C is a multibyte character, BASE_FACE
4861 is a face that has the same attributes. */
4864 lookup_face (f
, attr
, c
, base_face
)
4868 struct face
*base_face
;
4870 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4875 xassert (cache
!= NULL
);
4876 check_lface_attrs (attr
);
4878 /* Look up ATTR in the face cache. */
4879 hash
= lface_hash (attr
);
4880 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4882 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4883 if (face
->hash
== hash
4884 && (!FRAME_WINDOW_P (f
)
4885 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
4886 && lface_equal_p (face
->lface
, attr
))
4889 /* If not found, realize a new face. */
4891 face
= realize_face (cache
, attr
, c
, base_face
, -1);
4894 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4896 /* When this function is called from face_for_char (in this case, C is
4897 a multibyte character), a fontset of a face returned by
4898 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
4899 C) is not sutisfied. The fontset is set for this face by
4900 face_for_char later. */
4902 if (FRAME_WINDOW_P (f
))
4903 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
4905 #endif /* GLYPH_DEBUG */
4911 /* Return the face id of the realized face for named face SYMBOL on
4912 frame F suitable for displaying character C. */
4915 lookup_named_face (f
, symbol
, c
)
4920 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4921 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4922 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4924 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4925 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4926 merge_face_vectors (symbol_attrs
, attrs
);
4927 return lookup_face (f
, attrs
, c
, NULL
);
4931 /* Return the ID of the realized ASCII face of Lisp face with ID
4932 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4935 ascii_face_of_lisp_face (f
, lface_id
)
4941 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4943 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4944 face_id
= lookup_named_face (f
, face_name
, 0);
4953 /* Return a face for charset ASCII that is like the face with id
4954 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4955 STEPS < 0 means larger. Value is the id of the face. */
4958 smaller_face (f
, face_id
, steps
)
4962 #ifdef HAVE_WINDOW_SYSTEM
4964 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4965 int pt
, last_pt
, last_height
;
4968 struct face
*new_face
;
4970 /* If not called for an X frame, just return the original face. */
4971 if (FRAME_TERMCAP_P (f
))
4974 /* Try in increments of 1/2 pt. */
4975 delta
= steps
< 0 ? 5 : -5;
4976 steps
= abs (steps
);
4978 face
= FACE_FROM_ID (f
, face_id
);
4979 bcopy (face
->lface
, attrs
, sizeof attrs
);
4980 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4981 new_face_id
= face_id
;
4982 last_height
= FONT_HEIGHT (face
->font
);
4986 /* Give up if we cannot find a font within 10pt. */
4987 && abs (last_pt
- pt
) < 100)
4989 /* Look up a face for a slightly smaller/larger font. */
4991 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4992 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
4993 new_face
= FACE_FROM_ID (f
, new_face_id
);
4995 /* If height changes, count that as one step. */
4996 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4999 last_height
= FONT_HEIGHT (new_face
->font
);
5006 #else /* not HAVE_WINDOW_SYSTEM */
5010 #endif /* not HAVE_WINDOW_SYSTEM */
5014 /* Return a face for charset ASCII that is like the face with id
5015 FACE_ID on frame F, but has height HEIGHT. */
5018 face_with_height (f
, face_id
, height
)
5023 #ifdef HAVE_WINDOW_SYSTEM
5025 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5027 if (FRAME_TERMCAP_P (f
)
5031 face
= FACE_FROM_ID (f
, face_id
);
5032 bcopy (face
->lface
, attrs
, sizeof attrs
);
5033 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5034 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5035 #endif /* HAVE_WINDOW_SYSTEM */
5040 /* Return the face id of the realized face for named face SYMBOL on
5041 frame F suitable for displaying character C, and use attributes of
5042 the face FACE_ID for attributes that aren't completely specified by
5043 SYMBOL. This is like lookup_named_face, except that the default
5044 attributes come from FACE_ID, not from the default face. FACE_ID
5045 is assumed to be already realized. */
5048 lookup_derived_face (f
, symbol
, c
, face_id
)
5054 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5055 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5056 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5061 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5062 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5063 merge_face_vectors (symbol_attrs
, attrs
);
5064 return lookup_face (f
, attrs
, c
, default_face
);
5069 /***********************************************************************
5071 ***********************************************************************/
5073 DEFUN ("internal-set-font-selection-order",
5074 Finternal_set_font_selection_order
,
5075 Sinternal_set_font_selection_order
, 1, 1, 0,
5076 "Set font selection order for face font selection to ORDER.\n\
5077 ORDER must be a list of length 4 containing the symbols `:width',\n\
5078 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5079 first in ORDER are matched first, e.g. if `:height' appears before\n\
5080 `:weight' in ORDER, font selection first tries to find a font with\n\
5081 a suitable height, and then tries to match the font weight.\n\
5090 CHECK_LIST (order
, 0);
5091 bzero (indices
, sizeof indices
);
5095 CONSP (list
) && i
< DIM (indices
);
5096 list
= XCDR (list
), ++i
)
5098 Lisp_Object attr
= XCAR (list
);
5101 if (EQ (attr
, QCwidth
))
5103 else if (EQ (attr
, QCheight
))
5104 xlfd
= XLFD_POINT_SIZE
;
5105 else if (EQ (attr
, QCweight
))
5107 else if (EQ (attr
, QCslant
))
5112 if (indices
[i
] != 0)
5118 || i
!= DIM (indices
)
5123 signal_error ("Invalid font sort order", order
);
5125 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5127 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5128 free_all_realized_faces (Qnil
);
5135 DEFUN ("internal-set-alternative-font-family-alist",
5136 Finternal_set_alternative_font_family_alist
,
5137 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5138 "Define alternative font families to try in face font selection.\n\
5139 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5140 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5141 be found. Value is ALIST.")
5145 CHECK_LIST (alist
, 0);
5146 Vface_alternative_font_family_alist
= alist
;
5147 free_all_realized_faces (Qnil
);
5152 #ifdef HAVE_WINDOW_SYSTEM
5154 /* Value is non-zero if FONT is the name of a scalable font. The
5155 X11R6 XLFD spec says that point size, pixel size, and average width
5156 are zero for scalable fonts. Intlfonts contain at least one
5157 scalable font ("*-muleindian-1") for which this isn't true, so we
5158 just test average width. */
5161 font_scalable_p (font
)
5162 struct font_name
*font
;
5164 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5165 return (*s
== '0' && *(s
+ 1) == '\0')
5167 /* Windows implementation of XLFD is slightly broken for backward
5168 compatibility with previous broken versions, so test for
5169 wildcards as well as 0. */
5176 /* Value is non-zero if FONT1 is a better match for font attributes
5177 VALUES than FONT2. VALUES is an array of face attribute values in
5178 font sort order. COMPARE_PT_P zero means don't compare point
5182 better_font_p (values
, font1
, font2
, compare_pt_p
)
5184 struct font_name
*font1
, *font2
;
5189 for (i
= 0; i
< 4; ++i
)
5191 int xlfd_idx
= font_sort_order
[i
];
5193 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5195 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5196 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5198 if (delta1
> delta2
)
5200 else if (delta1
< delta2
)
5204 /* The difference may be equal because, e.g., the face
5205 specifies `italic' but we have only `regular' and
5206 `oblique'. Prefer `oblique' in this case. */
5207 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5208 && font1
->numeric
[xlfd_idx
] > values
[i
]
5209 && font2
->numeric
[xlfd_idx
] < values
[i
])
5221 /* Value is non-zero if FONT is an exact match for face attributes in
5222 SPECIFIED. SPECIFIED is an array of face attribute values in font
5226 exact_face_match_p (specified
, font
)
5228 struct font_name
*font
;
5232 for (i
= 0; i
< 4; ++i
)
5233 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5240 /* Value is the name of a scaled font, generated from scalable font
5241 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5242 Value is allocated from heap. */
5245 build_scalable_font_name (f
, font
, specified_pt
)
5247 struct font_name
*font
;
5250 char point_size
[20], pixel_size
[20];
5252 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5255 /* If scalable font is for a specific resolution, compute
5256 the point size we must specify from the resolution of
5257 the display and the specified resolution of the font. */
5258 if (font
->numeric
[XLFD_RESY
] != 0)
5260 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5261 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5266 pixel_value
= resy
/ 720.0 * pt
;
5269 /* Set point size of the font. */
5270 sprintf (point_size
, "%d", (int) pt
);
5271 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5272 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5274 /* Set pixel size. */
5275 sprintf (pixel_size
, "%d", pixel_value
);
5276 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5277 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5279 /* If font doesn't specify its resolution, use the
5280 resolution of the display. */
5281 if (font
->numeric
[XLFD_RESY
] == 0)
5284 sprintf (buffer
, "%d", (int) resy
);
5285 font
->fields
[XLFD_RESY
] = buffer
;
5286 font
->numeric
[XLFD_RESY
] = resy
;
5289 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5292 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5293 sprintf (buffer
, "%d", resx
);
5294 font
->fields
[XLFD_RESX
] = buffer
;
5295 font
->numeric
[XLFD_RESX
] = resx
;
5298 return build_font_name (font
);
5302 /* Value is non-zero if we are allowed to use scalable font FONT. We
5303 can't run a Lisp function here since this function may be called
5304 with input blocked. */
5307 may_use_scalable_font_p (font
, name
)
5308 struct font_name
*font
;
5311 if (EQ (Vscalable_fonts_allowed
, Qt
))
5313 else if (CONSP (Vscalable_fonts_allowed
))
5315 Lisp_Object tail
, regexp
;
5317 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5319 regexp
= XCAR (tail
);
5320 if (STRINGP (regexp
)
5321 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5329 #endif /* SCALABLE_FONTS != 0 */
5332 /* Return the name of the best matching font for face attributes
5333 ATTRS in the array of font_name structures FONTS which contains
5334 NFONTS elements. Value is a font name which is allocated from
5335 the heap. FONTS is freed by this function. */
5338 best_matching_font (f
, attrs
, fonts
, nfonts
)
5341 struct font_name
*fonts
;
5345 struct font_name
*best
;
5353 /* Make specified font attributes available in `specified',
5354 indexed by sort order. */
5355 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5357 int xlfd_idx
= font_sort_order
[i
];
5359 if (xlfd_idx
== XLFD_SWIDTH
)
5360 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5361 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5362 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5363 else if (xlfd_idx
== XLFD_WEIGHT
)
5364 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5365 else if (xlfd_idx
== XLFD_SLANT
)
5366 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5376 /* Start with the first non-scalable font in the list. */
5377 for (i
= 0; i
< nfonts
; ++i
)
5378 if (!font_scalable_p (fonts
+ i
))
5381 /* Find the best match among the non-scalable fonts. */
5386 for (i
= 1; i
< nfonts
; ++i
)
5387 if (!font_scalable_p (fonts
+ i
)
5388 && better_font_p (specified
, fonts
+ i
, best
, 1))
5392 exact_p
= exact_face_match_p (specified
, best
);
5401 /* Unless we found an exact match among non-scalable fonts, see if
5402 we can find a better match among scalable fonts. */
5405 /* A scalable font is better if
5407 1. its weight, slant, swidth attributes are better, or.
5409 2. the best non-scalable font doesn't have the required
5410 point size, and the scalable fonts weight, slant, swidth
5413 int non_scalable_has_exact_height_p
;
5415 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5416 non_scalable_has_exact_height_p
= 1;
5418 non_scalable_has_exact_height_p
= 0;
5420 for (i
= 0; i
< nfonts
; ++i
)
5421 if (font_scalable_p (fonts
+ i
))
5424 || better_font_p (specified
, fonts
+ i
, best
, 0)
5425 || (!non_scalable_has_exact_height_p
5426 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5431 if (font_scalable_p (best
))
5432 font_name
= build_scalable_font_name (f
, best
, pt
);
5434 font_name
= build_font_name (best
);
5436 #else /* !SCALABLE_FONTS */
5438 /* Find the best non-scalable font. */
5441 for (i
= 1; i
< nfonts
; ++i
)
5443 xassert (!font_scalable_p (fonts
+ i
));
5444 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5448 font_name
= build_font_name (best
);
5450 #endif /* !SCALABLE_FONTS */
5452 /* Free font_name structures. */
5453 free_font_names (fonts
, nfonts
);
5459 /* Try to get a list of fonts on frame F with font family FAMILY and
5460 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5461 of font_name structures for the fonts matched. Value is the number
5465 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5468 Lisp_Object pattern
, family
, registry
;
5469 struct font_name
**fonts
;
5473 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5474 family
= attrs
[LFACE_FAMILY_INDEX
];
5476 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5478 if (nfonts
== 0 && !NILP (family
))
5482 /* Try alternative font families from
5483 Vface_alternative_font_family_alist. */
5484 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5486 for (alter
= XCDR (alter
);
5487 CONSP (alter
) && nfonts
== 0;
5488 alter
= XCDR (alter
))
5490 if (STRINGP (XCAR (alter
)))
5491 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5494 /* Try font family of the default face or "fixed". */
5497 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5499 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5501 family
= build_string ("fixed");
5502 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5505 /* Try any family with the given registry. */
5507 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5514 /* Return the fontset id of the base fontset name or alias name given
5515 by the fontset attribute of ATTRS. Value is -1 if the fontset
5516 attribute of ATTRS doesn't name a fontset. */
5519 face_fontset (attrs
)
5525 name
= attrs
[LFACE_FONT_INDEX
];
5526 if (!STRINGP (name
))
5528 return fs_query_fontset (name
, 0);
5532 /* Choose a name of font to use on frame F to display character C with
5533 Lisp face attributes specified by ATTRS. The font name is
5534 determined by the font-related attributes in ATTRS and the name
5535 pattern for C in FONTSET. Value is the font name which is
5536 allocated from the heap and must be freed by the caller, or NULL if
5537 we can get no information about the font name of C. It is assured
5538 that we always get some information for a single byte
5542 choose_face_font (f
, attrs
, fontset
, c
)
5547 Lisp_Object pattern
;
5548 char *font_name
= NULL
;
5549 struct font_name
*fonts
;
5552 /* Get (foundry and) family name and registry (and encoding) name of
5554 pattern
= fontset_font_pattern (f
, fontset
, c
);
5557 xassert (!SINGLE_BYTE_CHAR_P (c
));
5560 /* If what we got is a name pattern, return it. */
5561 if (STRINGP (pattern
))
5562 return xstrdup (XSTRING (pattern
)->data
);
5564 /* Family name may be specified both in ATTRS and car part of
5565 PATTERN. The former has higher priority if C is a single byte
5567 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5568 && SINGLE_BYTE_CHAR_P (c
))
5569 XCAR (pattern
) = Qnil
;
5571 /* Get a list of fonts matching that pattern and choose the
5572 best match for the specified face attributes from it. */
5573 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
5575 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5579 #endif /* HAVE_WINDOW_SYSTEM */
5583 /***********************************************************************
5585 ***********************************************************************/
5587 /* Realize basic faces on frame F. Value is zero if frame parameters
5588 of F don't contain enough information needed to realize the default
5592 realize_basic_faces (f
)
5597 /* Block input there so that we won't be surprised by an X expose
5598 event, for instance without having the faces set up. */
5601 if (realize_default_face (f
))
5603 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5604 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5605 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5606 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5607 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5608 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5609 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5610 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5611 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5620 /* Realize the default face on frame F. If the face is not fully
5621 specified, make it fully-specified. Attributes of the default face
5622 that are not explicitly specified are taken from frame parameters. */
5625 realize_default_face (f
)
5628 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5630 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5631 Lisp_Object frame_font
;
5635 /* If the `default' face is not yet known, create it. */
5636 lface
= lface_from_face_name (f
, Qdefault
, 0);
5640 XSETFRAME (frame
, f
);
5641 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5644 #ifdef HAVE_WINDOW_SYSTEM
5645 if (FRAME_WINDOW_P (f
))
5647 /* Set frame_font to the value of the `font' frame parameter. */
5648 frame_font
= Fassq (Qfont
, f
->param_alist
);
5649 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5650 frame_font
= XCDR (frame_font
);
5651 set_lface_from_font_name (f
, lface
, frame_font
, 0, 1);
5653 #endif /* HAVE_WINDOW_SYSTEM */
5655 if (!FRAME_WINDOW_P (f
))
5657 LFACE_FAMILY (lface
) = build_string ("default");
5658 LFACE_SWIDTH (lface
) = Qnormal
;
5659 LFACE_HEIGHT (lface
) = make_number (1);
5660 LFACE_WEIGHT (lface
) = Qnormal
;
5661 LFACE_SLANT (lface
) = Qnormal
;
5664 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5665 LFACE_UNDERLINE (lface
) = Qnil
;
5667 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5668 LFACE_OVERLINE (lface
) = Qnil
;
5670 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5671 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5673 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5674 LFACE_BOX (lface
) = Qnil
;
5676 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5677 LFACE_INVERSE (lface
) = Qnil
;
5679 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5681 /* This function is called so early that colors are not yet
5682 set in the frame parameter list. */
5683 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5685 if (CONSP (color
) && STRINGP (XCDR (color
)))
5686 LFACE_FOREGROUND (lface
) = XCDR (color
);
5687 else if (FRAME_WINDOW_P (f
))
5689 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5690 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5695 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5697 /* This function is called so early that colors are not yet
5698 set in the frame parameter list. */
5699 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5700 if (CONSP (color
) && STRINGP (XCDR (color
)))
5701 LFACE_BACKGROUND (lface
) = XCDR (color
);
5702 else if (FRAME_WINDOW_P (f
))
5704 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5705 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5710 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5711 LFACE_STIPPLE (lface
) = Qnil
;
5713 /* Realize the face; it must be fully-specified now. */
5714 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5715 check_lface (lface
);
5716 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5717 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
5722 /* Realize basic faces other than the default face in face cache C.
5723 SYMBOL is the face name, ID is the face id the realized face must
5724 have. The default face must have been realized already. */
5727 realize_named_face (f
, symbol
, id
)
5732 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5733 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5734 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5735 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5736 struct face
*new_face
;
5738 /* The default face must exist and be fully specified. */
5739 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5740 check_lface_attrs (attrs
);
5741 xassert (lface_fully_specified_p (attrs
));
5743 /* If SYMBOL isn't know as a face, create it. */
5747 XSETFRAME (frame
, f
);
5748 lface
= Finternal_make_lisp_face (symbol
, frame
);
5751 /* Merge SYMBOL's face with the default face. */
5752 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5753 merge_face_vectors (symbol_attrs
, attrs
);
5755 /* Realize the face. */
5756 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
5760 /* Realize the fully-specified face with attributes ATTRS in face
5761 cache CACHE for character C. If C is a multibyte character,
5762 BASE_FACE is a face that has the same attributes. Otherwise,
5763 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
5764 ID of face to remove before caching the new face. Value is a
5765 pointer to the newly created realized face. */
5767 static struct face
*
5768 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
5769 struct face_cache
*cache
;
5772 struct face
*base_face
;
5777 /* LFACE must be fully specified. */
5778 xassert (cache
!= NULL
);
5779 check_lface_attrs (attrs
);
5781 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5783 /* Remove the former face. */
5784 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5785 uncache_face (cache
, former_face
);
5786 free_realized_face (cache
->f
, former_face
);
5789 if (FRAME_WINDOW_P (cache
->f
))
5790 face
= realize_x_face (cache
, attrs
, c
, base_face
);
5791 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5792 face
= realize_tty_face (cache
, attrs
, c
);
5796 /* Insert the new face. */
5797 cache_face (cache
, face
, lface_hash (attrs
));
5798 #ifdef HAVE_WINDOW_SYSTEM
5799 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
5800 load_face_font (cache
->f
, face
, c
);
5801 #endif /* HAVE_WINDOW_SYSTEM */
5806 /* Realize the fully-specified face with attributes ATTRS in face
5807 cache CACHE for character C. Do it for X frame CACHE->f. If C is
5808 a multibyte character, BASE_FACE is a face that has the same
5809 attributes. Otherwise, BASE_FACE is ignored. If the new face
5810 doesn't share font with the default face, a fontname is allocated
5811 from the heap and set in `font_name' of the new face, but it is not
5812 yet loaded here. Value is a pointer to the newly created realized
5815 static struct face
*
5816 realize_x_face (cache
, attrs
, c
, base_face
)
5817 struct face_cache
*cache
;
5820 struct face
*base_face
;
5822 #ifdef HAVE_WINDOW_SYSTEM
5823 struct face
*face
, *default_face
;
5825 Lisp_Object stipple
, overline
, strike_through
, box
;
5827 xassert (FRAME_WINDOW_P (cache
->f
));
5828 xassert (SINGLE_BYTE_CHAR_P (c
)
5831 /* Allocate a new realized face. */
5832 face
= make_realized_face (attrs
);
5836 /* If C is a multibyte character, we share all face attirbutes with
5837 BASE_FACE including the realized fontset. But, we must load a
5839 if (!SINGLE_BYTE_CHAR_P (c
))
5841 bcopy (base_face
, face
, sizeof *face
);
5843 face
->font
= NULL
; /* to force realize_face to load font */
5847 /* Now we are realizing a face for ASCII (and unibyte) characters. */
5849 /* Determine the font to use. Most of the time, the font will be
5850 the same as the font of the default face, so try that first. */
5851 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5853 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
5854 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5856 face
->font
= default_face
->font
;
5857 face
->fontset
= default_face
->fontset
;
5858 face
->font_info_id
= default_face
->font_info_id
;
5859 face
->font_name
= default_face
->font_name
;
5860 face
->ascii_face
= face
;
5862 /* But, as we can't share the fontset, make a new realized
5863 fontset that has the same base fontset as of the default
5866 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
5870 /* If the face attribute ATTRS specifies a fontset, use it as
5871 the base of a new realized fontset. Otherwise, use the
5872 default fontset as the base. The base determines registry
5873 and encoding of a font. It may also determine foundry and
5874 family. The other fields of font name pattern are
5875 constructed from ATTRS. */
5877 = make_fontset_for_ascii_face (f
, face_fontset (attrs
));
5878 face
->font
= NULL
; /* to force realize_face to load font */
5881 /* Load colors, and set remaining attributes. */
5883 load_face_colors (f
, face
, attrs
);
5886 box
= attrs
[LFACE_BOX_INDEX
];
5889 /* A simple box of line width 1 drawn in color given by
5891 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5893 face
->box
= FACE_SIMPLE_BOX
;
5894 face
->box_line_width
= 1;
5896 else if (INTEGERP (box
))
5898 /* Simple box of specified line width in foreground color of the
5900 xassert (XINT (box
) > 0);
5901 face
->box
= FACE_SIMPLE_BOX
;
5902 face
->box_line_width
= XFASTINT (box
);
5903 face
->box_color
= face
->foreground
;
5904 face
->box_color_defaulted_p
= 1;
5906 else if (CONSP (box
))
5908 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5909 being one of `raised' or `sunken'. */
5910 face
->box
= FACE_SIMPLE_BOX
;
5911 face
->box_color
= face
->foreground
;
5912 face
->box_color_defaulted_p
= 1;
5913 face
->box_line_width
= 1;
5917 Lisp_Object keyword
, value
;
5919 keyword
= XCAR (box
);
5927 if (EQ (keyword
, QCline_width
))
5929 if (INTEGERP (value
) && XINT (value
) > 0)
5930 face
->box_line_width
= XFASTINT (value
);
5932 else if (EQ (keyword
, QCcolor
))
5934 if (STRINGP (value
))
5936 face
->box_color
= load_color (f
, face
, value
,
5938 face
->use_box_color_for_shadows_p
= 1;
5941 else if (EQ (keyword
, QCstyle
))
5943 if (EQ (value
, Qreleased_button
))
5944 face
->box
= FACE_RAISED_BOX
;
5945 else if (EQ (value
, Qpressed_button
))
5946 face
->box
= FACE_SUNKEN_BOX
;
5951 /* Text underline, overline, strike-through. */
5953 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5955 /* Use default color (same as foreground color). */
5956 face
->underline_p
= 1;
5957 face
->underline_defaulted_p
= 1;
5958 face
->underline_color
= 0;
5960 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5962 /* Use specified color. */
5963 face
->underline_p
= 1;
5964 face
->underline_defaulted_p
= 0;
5965 face
->underline_color
5966 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5967 LFACE_UNDERLINE_INDEX
);
5969 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5971 face
->underline_p
= 0;
5972 face
->underline_defaulted_p
= 0;
5973 face
->underline_color
= 0;
5976 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5977 if (STRINGP (overline
))
5979 face
->overline_color
5980 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5981 LFACE_OVERLINE_INDEX
);
5982 face
->overline_p
= 1;
5984 else if (EQ (overline
, Qt
))
5986 face
->overline_color
= face
->foreground
;
5987 face
->overline_color_defaulted_p
= 1;
5988 face
->overline_p
= 1;
5991 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5992 if (STRINGP (strike_through
))
5994 face
->strike_through_color
5995 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5996 LFACE_STRIKE_THROUGH_INDEX
);
5997 face
->strike_through_p
= 1;
5999 else if (EQ (strike_through
, Qt
))
6001 face
->strike_through_color
= face
->foreground
;
6002 face
->strike_through_color_defaulted_p
= 1;
6003 face
->strike_through_p
= 1;
6006 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6007 if (!NILP (stipple
))
6008 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6010 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6012 #endif /* HAVE_WINDOW_SYSTEM */
6016 /* Realize the fully-specified face with attributes ATTRS in face
6017 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6018 pointer to the newly created realized face. */
6020 static struct face
*
6021 realize_tty_face (cache
, attrs
, c
)
6022 struct face_cache
*cache
;
6029 Lisp_Object tty_defined_color_alist
6030 = find_symbol_value (intern ("tty-defined-color-alist"));
6031 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6033 int face_colors_defaulted
= 0;
6035 /* Frame must be a termcap frame. */
6036 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6038 /* Allocate a new realized face. */
6039 face
= make_realized_face (attrs
);
6040 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6042 /* Map face attributes to TTY appearances. We map slant to
6043 dimmed text because we want italic text to appear differently
6044 and because dimmed text is probably used infrequently. */
6045 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6046 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6048 if (weight
> XLFD_WEIGHT_MEDIUM
)
6049 face
->tty_bold_p
= 1;
6050 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6051 face
->tty_dim_p
= 1;
6052 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6053 face
->tty_underline_p
= 1;
6054 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6055 face
->tty_reverse_p
= 1;
6057 /* Map color names to color indices. */
6058 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6059 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6061 XSETFRAME (frame
, cache
->f
);
6062 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6064 && XSTRING (color
)->size
6065 && CONSP (tty_defined_color_alist
)
6066 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6068 /* Associations in tty-defined-color-alist are of the form
6069 (NAME INDEX R G B). We need the INDEX part. */
6070 face
->foreground
= XINT (XCAR (XCDR (color
)));
6072 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6073 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6075 face
->foreground
= load_color (cache
->f
, face
,
6076 attrs
[LFACE_FOREGROUND_INDEX
],
6077 LFACE_FOREGROUND_INDEX
);
6079 #if defined (MSDOS) || defined (WINDOWSNT)
6080 /* If the foreground of the default face is the default color,
6081 use the foreground color defined by the frame. */
6083 if (FRAME_MSDOS_P (cache
->f
))
6087 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6088 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6090 face
->foreground
= FRAME_FOREGROUND_PIXEL (cache
->f
);
6091 attrs
[LFACE_FOREGROUND_INDEX
] =
6092 tty_color_name (cache
->f
, face
->foreground
);
6093 face_colors_defaulted
= 1;
6095 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6097 face
->foreground
= FRAME_BACKGROUND_PIXEL (cache
->f
);
6098 attrs
[LFACE_FOREGROUND_INDEX
] =
6099 tty_color_name (cache
->f
, face
->foreground
);
6100 face_colors_defaulted
= 1;
6105 #endif /* MSDOS or WINDOWSNT */
6108 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6110 && XSTRING (color
)->size
6111 && CONSP (tty_defined_color_alist
)
6112 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6114 /* Associations in tty-defined-color-alist are of the form
6115 (NAME INDEX R G B). We need the INDEX part. */
6116 face
->background
= XINT (XCAR (XCDR (color
)));
6118 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6119 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6121 face
->background
= load_color (cache
->f
, face
,
6122 attrs
[LFACE_BACKGROUND_INDEX
],
6123 LFACE_BACKGROUND_INDEX
);
6124 #if defined (MSDOS) || defined (WINDOWSNT)
6125 /* If the background of the default face is the default color,
6126 use the background color defined by the frame. */
6128 if (FRAME_MSDOS_P (cache
->f
))
6132 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6133 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6135 face
->background
= FRAME_BACKGROUND_PIXEL (cache
->f
);
6136 attrs
[LFACE_BACKGROUND_INDEX
] =
6137 tty_color_name (cache
->f
, face
->background
);
6138 face_colors_defaulted
= 1;
6140 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6142 face
->background
= FRAME_FOREGROUND_PIXEL (cache
->f
);
6143 attrs
[LFACE_BACKGROUND_INDEX
] =
6144 tty_color_name (cache
->f
, face
->background
);
6145 face_colors_defaulted
= 1;
6150 #endif /* MSDOS or WINDOWSNT */
6153 /* Swap colors if face is inverse-video. If the colors are taken
6154 from the frame colors, they are already inverted, since the
6155 frame-creation function calls x-handle-reverse-video. */
6156 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6158 unsigned long tem
= face
->foreground
;
6160 face
->foreground
= face
->background
;
6161 face
->background
= tem
;
6164 if (tty_suppress_bold_inverse_default_colors_p
6166 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6167 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6168 face
->tty_bold_p
= 0;
6174 DEFUN ("tty-suppress-bold-inverse-default-colors",
6175 Ftty_suppress_bold_inverse_default_colors
,
6176 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6177 "Suppress/allow boldness of faces with inverse default colors.\n\
6178 SUPPRESS non-nil means suppress it.\n\
6179 This affects bold faces on TTYs whose foreground is the default background\n\
6180 color of the display and whose background is the default foreground color.\n\
6181 For such faces, no bold text will be displayed.")
6183 Lisp_Object suppress
;
6185 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6186 ++face_change_count
;
6192 /***********************************************************************
6194 ***********************************************************************/
6196 /* Return the ID of the face to use to display character CH with face
6197 property PROP on frame F in current_buffer. */
6200 compute_char_face (f
, ch
, prop
)
6207 if (NILP (current_buffer
->enable_multibyte_characters
))
6212 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6213 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6217 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6218 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6219 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6220 merge_face_vector_with_property (f
, attrs
, prop
);
6221 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6228 /* Return the face ID associated with buffer position POS for
6229 displaying ASCII characters. Return in *ENDPTR the position at
6230 which a different face is needed, as far as text properties and
6231 overlays are concerned. W is a window displaying current_buffer.
6233 REGION_BEG, REGION_END delimit the region, so it can be
6236 LIMIT is a position not to scan beyond. That is to limit the time
6237 this function can take.
6239 If MOUSE is non-zero, use the character's mouse-face, not its face.
6241 The face returned is suitable for displaying ASCII characters. */
6244 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6245 endptr
, limit
, mouse
)
6248 int region_beg
, region_end
;
6253 struct frame
*f
= XFRAME (w
->frame
);
6254 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6255 Lisp_Object prop
, position
;
6257 Lisp_Object
*overlay_vec
;
6260 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6261 Lisp_Object limit1
, end
;
6262 struct face
*default_face
;
6263 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6265 /* W must display the current buffer. We could write this function
6266 to use the frame and buffer of W, but right now it doesn't. */
6267 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6269 XSETFRAME (frame
, f
);
6270 XSETFASTINT (position
, pos
);
6273 if (pos
< region_beg
&& region_beg
< endpos
)
6274 endpos
= region_beg
;
6276 /* Get the `face' or `mouse_face' text property at POS, and
6277 determine the next position at which the property changes. */
6278 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6279 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6280 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6282 endpos
= XINT (end
);
6284 /* Look at properties from overlays. */
6289 /* First try with room for 40 overlays. */
6291 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6292 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6293 &next_overlay
, NULL
);
6295 /* If there are more than 40, make enough space for all, and try
6297 if (noverlays
> len
)
6300 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6301 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6302 &next_overlay
, NULL
);
6305 if (next_overlay
< endpos
)
6306 endpos
= next_overlay
;
6311 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6313 /* Optimize common cases where we can use the default face. */
6316 && !(pos
>= region_beg
&& pos
< region_end
))
6317 return DEFAULT_FACE_ID
;
6319 /* Begin with attributes from the default face. */
6320 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6322 /* Merge in attributes specified via text properties. */
6324 merge_face_vector_with_property (f
, attrs
, prop
);
6326 /* Now merge the overlay data. */
6327 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6328 for (i
= 0; i
< noverlays
; i
++)
6333 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6335 merge_face_vector_with_property (f
, attrs
, prop
);
6337 oend
= OVERLAY_END (overlay_vec
[i
]);
6338 oendpos
= OVERLAY_POSITION (oend
);
6339 if (oendpos
< endpos
)
6343 /* If in the region, merge in the region face. */
6344 if (pos
>= region_beg
&& pos
< region_end
)
6346 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6347 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6349 if (region_end
< endpos
)
6350 endpos
= region_end
;
6355 /* Look up a realized face with the given face attributes,
6356 or realize a new one for ASCII characters. */
6357 return lookup_face (f
, attrs
, 0, NULL
);
6361 /* Compute the face at character position POS in Lisp string STRING on
6362 window W, for ASCII characters.
6364 If STRING is an overlay string, it comes from position BUFPOS in
6365 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6366 not an overlay string. W must display the current buffer.
6367 REGION_BEG and REGION_END give the start and end positions of the
6368 region; both are -1 if no region is visible. BASE_FACE_ID is the
6369 id of the basic face to merge with. It is usually equal to
6370 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6371 for strings displayed in the mode or top line.
6373 Set *ENDPTR to the next position where to check for faces in
6374 STRING; -1 if the face is constant from POS to the end of the
6377 Value is the id of the face to use. The face returned is suitable
6378 for displaying ASCII characters. */
6381 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6382 region_end
, endptr
, base_face_id
)
6386 int region_beg
, region_end
;
6388 enum face_id base_face_id
;
6390 Lisp_Object prop
, position
, end
, limit
;
6391 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6392 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6393 struct face
*base_face
;
6394 int multibyte_p
= STRING_MULTIBYTE (string
);
6396 /* Get the value of the face property at the current position within
6397 STRING. Value is nil if there is no face property. */
6398 XSETFASTINT (position
, pos
);
6399 prop
= Fget_text_property (position
, Qface
, string
);
6401 /* Get the next position at which to check for faces. Value of end
6402 is nil if face is constant all the way to the end of the string.
6403 Otherwise it is a string position where to check faces next.
6404 Limit is the maximum position up to which to check for property
6405 changes in Fnext_single_property_change. Strings are usually
6406 short, so set the limit to the end of the string. */
6407 XSETFASTINT (limit
, XSTRING (string
)->size
);
6408 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6410 *endptr
= XFASTINT (end
);
6414 base_face
= FACE_FROM_ID (f
, base_face_id
);
6415 xassert (base_face
);
6417 /* Optimize the default case that there is no face property and we
6418 are not in the region. */
6420 && (base_face_id
!= DEFAULT_FACE_ID
6421 /* BUFPOS <= 0 means STRING is not an overlay string, so
6422 that the region doesn't have to be taken into account. */
6424 || bufpos
< region_beg
6425 || bufpos
>= region_end
)
6427 /* We can't realize faces for different charsets differently
6428 if we don't have fonts, so we can stop here if not working
6429 on a window-system frame. */
6430 || !FRAME_WINDOW_P (f
)
6431 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6432 return base_face
->id
;
6434 /* Begin with attributes from the base face. */
6435 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6437 /* Merge in attributes specified via text properties. */
6439 merge_face_vector_with_property (f
, attrs
, prop
);
6441 /* If in the region, merge in the region face. */
6443 && bufpos
>= region_beg
6444 && bufpos
< region_end
)
6446 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6447 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6450 /* Look up a realized face with the given face attributes,
6451 or realize a new one for ASCII characters. */
6452 return lookup_face (f
, attrs
, 0, NULL
);
6457 /***********************************************************************
6459 ***********************************************************************/
6463 /* Print the contents of the realized face FACE to stderr. */
6466 dump_realized_face (face
)
6469 fprintf (stderr
, "ID: %d\n", face
->id
);
6470 #ifdef HAVE_X_WINDOWS
6471 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6473 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6475 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6476 fprintf (stderr
, "background: 0x%lx (%s)\n",
6478 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6479 fprintf (stderr
, "font_name: %s (%s)\n",
6481 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6482 #ifdef HAVE_X_WINDOWS
6483 fprintf (stderr
, "font = %p\n", face
->font
);
6485 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6486 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6487 fprintf (stderr
, "underline: %d (%s)\n",
6489 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6490 fprintf (stderr
, "hash: %d\n", face
->hash
);
6491 fprintf (stderr
, "charset: %d\n", face
->charset
);
6495 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6503 fprintf (stderr
, "font selection order: ");
6504 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6505 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6506 fprintf (stderr
, "\n");
6508 fprintf (stderr
, "alternative fonts: ");
6509 debug_print (Vface_alternative_font_family_alist
);
6510 fprintf (stderr
, "\n");
6512 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6513 Fdump_face (make_number (i
));
6518 CHECK_NUMBER (n
, 0);
6519 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6521 error ("Not a valid face");
6522 dump_realized_face (face
);
6529 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6533 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6534 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6535 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6539 #endif /* GLYPH_DEBUG != 0 */
6543 /***********************************************************************
6545 ***********************************************************************/
6550 Qface
= intern ("face");
6552 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6553 staticpro (&Qbitmap_spec_p
);
6554 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6555 staticpro (&Qframe_update_face_colors
);
6557 /* Lisp face attribute keywords. */
6558 QCfamily
= intern (":family");
6559 staticpro (&QCfamily
);
6560 QCheight
= intern (":height");
6561 staticpro (&QCheight
);
6562 QCweight
= intern (":weight");
6563 staticpro (&QCweight
);
6564 QCslant
= intern (":slant");
6565 staticpro (&QCslant
);
6566 QCunderline
= intern (":underline");
6567 staticpro (&QCunderline
);
6568 QCinverse_video
= intern (":inverse-video");
6569 staticpro (&QCinverse_video
);
6570 QCreverse_video
= intern (":reverse-video");
6571 staticpro (&QCreverse_video
);
6572 QCforeground
= intern (":foreground");
6573 staticpro (&QCforeground
);
6574 QCbackground
= intern (":background");
6575 staticpro (&QCbackground
);
6576 QCstipple
= intern (":stipple");;
6577 staticpro (&QCstipple
);
6578 QCwidth
= intern (":width");
6579 staticpro (&QCwidth
);
6580 QCfont
= intern (":font");
6581 staticpro (&QCfont
);
6582 QCbold
= intern (":bold");
6583 staticpro (&QCbold
);
6584 QCitalic
= intern (":italic");
6585 staticpro (&QCitalic
);
6586 QCoverline
= intern (":overline");
6587 staticpro (&QCoverline
);
6588 QCstrike_through
= intern (":strike-through");
6589 staticpro (&QCstrike_through
);
6590 QCbox
= intern (":box");
6593 /* Symbols used for Lisp face attribute values. */
6594 QCcolor
= intern (":color");
6595 staticpro (&QCcolor
);
6596 QCline_width
= intern (":line-width");
6597 staticpro (&QCline_width
);
6598 QCstyle
= intern (":style");
6599 staticpro (&QCstyle
);
6600 Qreleased_button
= intern ("released-button");
6601 staticpro (&Qreleased_button
);
6602 Qpressed_button
= intern ("pressed-button");
6603 staticpro (&Qpressed_button
);
6604 Qnormal
= intern ("normal");
6605 staticpro (&Qnormal
);
6606 Qultra_light
= intern ("ultra-light");
6607 staticpro (&Qultra_light
);
6608 Qextra_light
= intern ("extra-light");
6609 staticpro (&Qextra_light
);
6610 Qlight
= intern ("light");
6611 staticpro (&Qlight
);
6612 Qsemi_light
= intern ("semi-light");
6613 staticpro (&Qsemi_light
);
6614 Qsemi_bold
= intern ("semi-bold");
6615 staticpro (&Qsemi_bold
);
6616 Qbold
= intern ("bold");
6618 Qextra_bold
= intern ("extra-bold");
6619 staticpro (&Qextra_bold
);
6620 Qultra_bold
= intern ("ultra-bold");
6621 staticpro (&Qultra_bold
);
6622 Qoblique
= intern ("oblique");
6623 staticpro (&Qoblique
);
6624 Qitalic
= intern ("italic");
6625 staticpro (&Qitalic
);
6626 Qreverse_oblique
= intern ("reverse-oblique");
6627 staticpro (&Qreverse_oblique
);
6628 Qreverse_italic
= intern ("reverse-italic");
6629 staticpro (&Qreverse_italic
);
6630 Qultra_condensed
= intern ("ultra-condensed");
6631 staticpro (&Qultra_condensed
);
6632 Qextra_condensed
= intern ("extra-condensed");
6633 staticpro (&Qextra_condensed
);
6634 Qcondensed
= intern ("condensed");
6635 staticpro (&Qcondensed
);
6636 Qsemi_condensed
= intern ("semi-condensed");
6637 staticpro (&Qsemi_condensed
);
6638 Qsemi_expanded
= intern ("semi-expanded");
6639 staticpro (&Qsemi_expanded
);
6640 Qexpanded
= intern ("expanded");
6641 staticpro (&Qexpanded
);
6642 Qextra_expanded
= intern ("extra-expanded");
6643 staticpro (&Qextra_expanded
);
6644 Qultra_expanded
= intern ("ultra-expanded");
6645 staticpro (&Qultra_expanded
);
6646 Qbackground_color
= intern ("background-color");
6647 staticpro (&Qbackground_color
);
6648 Qforeground_color
= intern ("foreground-color");
6649 staticpro (&Qforeground_color
);
6650 Qunspecified
= intern ("unspecified");
6651 staticpro (&Qunspecified
);
6653 Qface_alias
= intern ("face-alias");
6654 staticpro (&Qface_alias
);
6655 Qdefault
= intern ("default");
6656 staticpro (&Qdefault
);
6657 Qtool_bar
= intern ("tool-bar");
6658 staticpro (&Qtool_bar
);
6659 Qregion
= intern ("region");
6660 staticpro (&Qregion
);
6661 Qfringe
= intern ("fringe");
6662 staticpro (&Qfringe
);
6663 Qheader_line
= intern ("header-line");
6664 staticpro (&Qheader_line
);
6665 Qscroll_bar
= intern ("scroll-bar");
6666 staticpro (&Qscroll_bar
);
6667 Qmenu
= intern ("menu");
6669 Qcursor
= intern ("cursor");
6670 staticpro (&Qcursor
);
6671 Qborder
= intern ("border");
6672 staticpro (&Qborder
);
6673 Qmouse
= intern ("mouse");
6674 staticpro (&Qmouse
);
6675 Qtty_color_desc
= intern ("tty-color-desc");
6676 staticpro (&Qtty_color_desc
);
6677 Qtty_color_by_index
= intern ("tty-color-by-index");
6678 staticpro (&Qtty_color_by_index
);
6680 defsubr (&Sinternal_make_lisp_face
);
6681 defsubr (&Sinternal_lisp_face_p
);
6682 defsubr (&Sinternal_set_lisp_face_attribute
);
6683 #ifdef HAVE_WINDOW_SYSTEM
6684 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6686 defsubr (&Scolor_gray_p
);
6687 defsubr (&Scolor_supported_p
);
6688 defsubr (&Sinternal_get_lisp_face_attribute
);
6689 defsubr (&Sinternal_lisp_face_attribute_values
);
6690 defsubr (&Sinternal_lisp_face_equal_p
);
6691 defsubr (&Sinternal_lisp_face_empty_p
);
6692 defsubr (&Sinternal_copy_lisp_face
);
6693 defsubr (&Sinternal_merge_in_global_face
);
6694 defsubr (&Sface_font
);
6695 defsubr (&Sframe_face_alist
);
6696 defsubr (&Sinternal_set_font_selection_order
);
6697 defsubr (&Sinternal_set_alternative_font_family_alist
);
6699 defsubr (&Sdump_face
);
6700 defsubr (&Sshow_face_resources
);
6701 #endif /* GLYPH_DEBUG */
6702 defsubr (&Sclear_face_cache
);
6703 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6705 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6706 "*Limit for font matching.\n\
6707 If an integer > 0, font matching functions won't load more than\n\
6708 that number of fonts when searching for a matching font.");
6709 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6711 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6712 "List of global face definitions (for internal use only.)");
6713 Vface_new_frame_defaults
= Qnil
;
6715 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6716 "*Default stipple pattern used on monochrome displays.\n\
6717 This stipple pattern is used on monochrome displays\n\
6718 instead of shades of gray for a face background color.\n\
6719 See `set-face-stipple' for possible values for this variable.");
6720 Vface_default_stipple
= build_string ("gray3");
6722 DEFVAR_LISP ("face-alternative-font-family-alist",
6723 &Vface_alternative_font_family_alist
, "");
6724 Vface_alternative_font_family_alist
= Qnil
;
6728 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6729 "Allowed scalable fonts.\n\
6730 A value of nil means don't allow any scalable fonts.\n\
6731 A value of t means allow any scalable font.\n\
6732 Otherwise, value must be a list of regular expressions. A font may be\n\
6733 scaled if its name matches a regular expression in the list.");
6735 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
6736 by default limits the fonts available severely. */
6737 Vscalable_fonts_allowed
= Qt
;
6739 Vscalable_fonts_allowed
= Qnil
;
6741 #endif /* SCALABLE_FONTS */
6743 #ifdef HAVE_WINDOW_SYSTEM
6744 defsubr (&Sbitmap_spec_p
);
6745 defsubr (&Sx_list_fonts
);
6746 defsubr (&Sinternal_face_x_get_resource
);
6747 defsubr (&Sx_family_fonts
);
6748 defsubr (&Sx_font_family_list
);
6749 #endif /* HAVE_WINDOW_SYSTEM */