1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
25 When using Emacs with X, the display style of characters can be
26 changed by defining `faces'. Each face can specify the following
31 2. Relative proportionate width, aka character set width or set
32 width (swidth), e.g. `semi-compressed'.
34 3. Font height in 1/10pt.
36 4. Font weight, e.g. `bold'.
38 5. Font slant, e.g. `italic'.
44 8. Whether or not characters should be underlined, and in what color.
46 9. Whether or not characters should be displayed in inverse video.
48 10. A background stipple, a bitmap.
50 11. Whether or not characters should be overlined, and in what color.
52 12. Whether or not characters should be strike-through, and in what
55 13. Whether or not a box should be drawn around characters, the box
56 type, and, for simple boxes, in what color.
58 14. Font or fontset pattern, or nil. This is a special attribute.
59 When this attribyte is specified, the face uses a font opened by
60 that pattern as is. In addition, all the other font-related
61 attributes (1st thru 5th) are generated from the opened font name.
62 On the other hand, if one of the other font-related attributes are
63 specified, this attribute is set to nil. In that case, the face
64 doesn't inherit this attribute from the `default' face, and uses a
65 font determined by the other attributes (those may be inherited
66 from the `default' face).
68 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_WINDOW_SYSTEM
199 #ifdef HAVE_X_WINDOWS
203 #include <Xm/XmStrDefs.h>
204 #endif /* USE_MOTIF */
214 /* Redefine X specifics to W32 equivalents to avoid cluttering the
215 code with #ifdef blocks. */
216 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
217 #define x_display_info w32_display_info
218 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
219 #define check_x check_w32
220 #define x_list_fonts w32_list_fonts
221 #define GCGraphicsExposures 0
222 /* For historic reasons, FONT_WIDTH refers to average width on W32,
223 not maximum as on X. Redefine here. */
224 #define FONT_WIDTH FONT_MAX_WIDTH
228 #include "dispextern.h"
229 #include "blockinput.h"
231 #include "intervals.h"
233 #ifdef HAVE_X_WINDOWS
235 /* Compensate for a bug in Xos.h on some systems, on which it requires
236 time.h. On some such systems, Xos.h tries to redefine struct
237 timeval and struct timezone if USG is #defined while it is
240 #ifdef XOS_NEEDS_TIME_H
246 #else /* not XOS_NEEDS_TIME_H */
248 #endif /* not XOS_NEEDS_TIME_H */
250 #endif /* HAVE_X_WINDOWS */
254 #include "keyboard.h"
257 #define max(A, B) ((A) > (B) ? (A) : (B))
258 #define min(A, B) ((A) < (B) ? (A) : (B))
259 #define abs(X) ((X) < 0 ? -(X) : (X))
262 /* Non-zero if face attribute ATTR is unspecified. */
264 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
266 /* Value is the number of elements of VECTOR. */
268 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
270 /* Make a copy of string S on the stack using alloca. Value is a pointer
273 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
275 /* Make a copy of the contents of Lisp string S on the stack using
276 alloca. Value is a pointer to the copy. */
278 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
280 /* Size of hash table of realized faces in face caches (should be a
283 #define FACE_CACHE_BUCKETS_SIZE 1001
285 /* A definition of XColor for non-X frames. */
287 #ifndef HAVE_X_WINDOWS
292 unsigned short red
, green
, blue
;
298 #endif /* not HAVE_X_WINDOWS */
300 /* Keyword symbols used for face attribute names. */
302 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
303 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
304 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
305 Lisp_Object QCreverse_video
;
306 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
308 /* Symbols used for attribute values. */
310 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
311 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
312 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
313 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
314 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
315 Lisp_Object Qultra_expanded
;
316 Lisp_Object Qreleased_button
, Qpressed_button
;
317 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
318 Lisp_Object Qunspecified
;
320 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
322 /* The name of the function to call when the background of the frame
323 has changed, frame_update_face_colors. */
325 Lisp_Object Qframe_update_face_colors
;
327 /* Names of basic faces. */
329 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
330 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
331 extern Lisp_Object Qmode_line
;
333 /* The symbol `face-alias'. A symbols having that property is an
334 alias for another face. Value of the property is the name of
337 Lisp_Object Qface_alias
;
339 /* Names of frame parameters related to faces. */
341 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
342 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
344 /* Default stipple pattern used on monochrome displays. This stipple
345 pattern is used on monochrome displays instead of shades of gray
346 for a face background color. See `set-face-stipple' for possible
347 values for this variable. */
349 Lisp_Object Vface_default_stipple
;
351 /* Alist of alternative font families. Each element is of the form
352 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
353 try FAMILY1, then FAMILY2, ... */
355 Lisp_Object Vface_alternative_font_family_alist
;
357 /* Allowed scalable fonts. A value of nil means don't allow any
358 scalable fonts. A value of t means allow the use of any scalable
359 font. Otherwise, value must be a list of regular expressions. A
360 font may be scaled if its name matches a regular expression in the
364 Lisp_Object Vscalable_fonts_allowed
;
367 /* Maximum number of fonts to consider in font_list. If not an
368 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
370 Lisp_Object Vfont_list_limit
;
371 #define DEFAULT_FONT_LIST_LIMIT 100
373 /* The symbols `foreground-color' and `background-color' which can be
374 used as part of a `face' property. This is for compatibility with
377 Lisp_Object Qforeground_color
, Qbackground_color
;
379 /* The symbols `face' and `mouse-face' used as text properties. */
382 extern Lisp_Object Qmouse_face
;
384 /* Error symbol for wrong_type_argument in load_pixmap. */
386 Lisp_Object Qbitmap_spec_p
;
388 /* Alist of global face definitions. Each element is of the form
389 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
390 is a Lisp vector of face attributes. These faces are used
391 to initialize faces for new frames. */
393 Lisp_Object Vface_new_frame_defaults
;
395 /* The next ID to assign to Lisp faces. */
397 static int next_lface_id
;
399 /* A vector mapping Lisp face Id's to face names. */
401 static Lisp_Object
*lface_id_to_name
;
402 static int lface_id_to_name_size
;
404 /* TTY color-related functions (defined in tty-colors.el). */
406 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
408 /* The name of the function used to compute colors on TTYs. */
410 Lisp_Object Qtty_color_alist
;
412 /* An alist of defined terminal colors and their RGB values. */
414 Lisp_Object Vtty_defined_color_alist
;
416 /* Counter for calls to clear_face_cache. If this counter reaches
417 CLEAR_FONT_TABLE_COUNT, and a frame has more than
418 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
420 static int clear_font_table_count
;
421 #define CLEAR_FONT_TABLE_COUNT 100
422 #define CLEAR_FONT_TABLE_NFONTS 10
424 /* Non-zero means face attributes have been changed since the last
425 redisplay. Used in redisplay_internal. */
427 int face_change_count
;
429 /* Non-zero means don't display bold text if a face's foreground
430 and background colors are the inverse of the default colors of the
431 display. This is a kluge to suppress `bold black' foreground text
432 which is hard to read on an LCD monitor. */
434 int tty_suppress_bold_inverse_default_colors_p
;
436 /* The total number of colors currently allocated. */
439 static int ncolors_allocated
;
440 static int npixmaps_allocated
;
446 /* Function prototypes. */
451 static void map_tty_color
P_ ((struct frame
*, struct face
*,
452 enum lface_attribute_index
, int *));
453 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
454 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
455 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
456 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
458 static int first_font_matching
P_ ((struct frame
*f
, char *,
459 struct font_name
*));
460 static int x_face_list_fonts
P_ ((struct frame
*, char *,
461 struct font_name
*, int, int, int));
462 static int font_scalable_p
P_ ((struct font_name
*));
463 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
464 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
465 static unsigned char *xstrlwr
P_ ((unsigned char *));
466 static void signal_error
P_ ((char *, Lisp_Object
));
467 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
468 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
469 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
470 static void free_face_colors
P_ ((struct frame
*, struct face
*));
471 static int face_color_gray_p
P_ ((struct frame
*, char *));
472 static char *build_font_name
P_ ((struct font_name
*));
473 static void free_font_names
P_ ((struct font_name
*, int));
474 static int sorted_font_list
P_ ((struct frame
*, char *,
475 int (*cmpfn
) P_ ((const void *, const void *)),
476 struct font_name
**));
477 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
478 Lisp_Object
, struct font_name
**));
479 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
480 Lisp_Object
, Lisp_Object
, struct font_name
**));
481 static int cmp_font_names
P_ ((const void *, const void *));
482 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
483 struct face
*, int));
484 static struct face
*realize_x_face
P_ ((struct face_cache
*,
485 Lisp_Object
*, int, struct face
*));
486 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
487 Lisp_Object
*, int));
488 static int realize_basic_faces
P_ ((struct frame
*));
489 static int realize_default_face
P_ ((struct frame
*));
490 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
491 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
492 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
493 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
494 static unsigned lface_hash
P_ ((Lisp_Object
*));
495 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
496 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
497 static void free_realized_face
P_ ((struct frame
*, struct face
*));
498 static void clear_face_gcs
P_ ((struct face_cache
*));
499 static void free_face_cache
P_ ((struct face_cache
*));
500 static int face_numeric_weight
P_ ((Lisp_Object
));
501 static int face_numeric_slant
P_ ((Lisp_Object
));
502 static int face_numeric_swidth
P_ ((Lisp_Object
));
503 static int face_fontset
P_ ((Lisp_Object
*));
504 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
505 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
506 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
508 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
509 Lisp_Object
, int, int));
510 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
511 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
512 static void free_realized_faces
P_ ((struct face_cache
*));
513 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
514 struct font_name
*, int));
515 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
516 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
517 static int xlfd_numeric_slant
P_ ((struct font_name
*));
518 static int xlfd_numeric_weight
P_ ((struct font_name
*));
519 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
520 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
521 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
522 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
523 static int xlfd_fixed_p
P_ ((struct font_name
*));
524 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
526 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
527 struct font_name
*, int,
529 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
530 struct font_name
*, int));
532 #ifdef HAVE_WINDOW_SYSTEM
534 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
535 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
536 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
537 int (*cmpfn
) P_ ((const void *, const void *))));
538 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
539 static void x_free_gc
P_ ((struct frame
*, GC
));
540 static void clear_font_table
P_ ((struct frame
*));
543 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
544 #endif /* WINDOWSNT */
546 #endif /* HAVE_WINDOW_SYSTEM */
549 /***********************************************************************
551 ***********************************************************************/
553 #ifdef HAVE_X_WINDOWS
555 #ifdef DEBUG_X_COLORS
557 /* The following is a poor mans infrastructure for debugging X color
558 allocation problems on displays with PseudoColor-8. Some X servers
559 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
560 color reference counts completely so that they don't signal an
561 error when a color is freed whose reference count is already 0.
562 Other X servers do. To help me debug this, the following code
563 implements a simple reference counting schema of its own, for a
564 single display/screen. --gerd. */
566 /* Reference counts for pixel colors. */
568 int color_count
[256];
570 /* Register color PIXEL as allocated. */
573 register_color (pixel
)
576 xassert (pixel
< 256);
577 ++color_count
[pixel
];
581 /* Register color PIXEL as deallocated. */
584 unregister_color (pixel
)
587 xassert (pixel
< 256);
588 if (color_count
[pixel
] > 0)
589 --color_count
[pixel
];
595 /* Register N colors from PIXELS as deallocated. */
598 unregister_colors (pixels
, n
)
599 unsigned long *pixels
;
603 for (i
= 0; i
< n
; ++i
)
604 unregister_color (pixels
[i
]);
608 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
609 "Dump currently allocated colors and their reference counts to stderr.")
614 fputc ('\n', stderr
);
616 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
619 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
622 fputc ('\n', stderr
);
624 fputc ('\t', stderr
);
628 fputc ('\n', stderr
);
633 #endif /* DEBUG_X_COLORS */
635 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
636 color values. Interrupt input must be blocked when this function
640 x_free_colors (f
, pixels
, npixels
)
642 unsigned long *pixels
;
645 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
647 /* If display has an immutable color map, freeing colors is not
648 necessary and some servers don't allow it. So don't do it. */
649 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
651 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
653 #ifdef DEBUG_X_COLORS
654 unregister_colors (pixels
, npixels
);
660 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
661 color values. Interrupt input must be blocked when this function
665 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
669 unsigned long *pixels
;
672 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
673 int class = dpyinfo
->visual
->class;
675 /* If display has an immutable color map, freeing colors is not
676 necessary and some servers don't allow it. So don't do it. */
677 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
679 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
680 #ifdef DEBUG_X_COLORS
681 unregister_colors (pixels
, npixels
);
687 /* Create and return a GC for use on frame F. GC values and mask
688 are given by XGCV and MASK. */
691 x_create_gc (f
, mask
, xgcv
)
698 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
705 /* Free GC which was used on frame F. */
713 xassert (--ngcs
>= 0);
714 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
718 #endif /* HAVE_X_WINDOWS */
721 /* W32 emulation of GCs */
724 x_create_gc (f
, mask
, xgcv
)
731 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
738 /* Free GC which was used on frame F. */
746 xassert (--ngcs
>= 0);
751 #endif /* WINDOWSNT */
753 /* Like stricmp. Used to compare parts of font names which are in
758 unsigned char *s1
, *s2
;
762 unsigned char c1
= tolower (*s1
);
763 unsigned char c2
= tolower (*s2
);
765 return c1
< c2
? -1 : 1;
770 return *s2
== 0 ? 0 : -1;
775 /* Like strlwr, which might not always be available. */
777 static unsigned char *
781 unsigned char *p
= s
;
790 /* Signal `error' with message S, and additional argument ARG. */
793 signal_error (s
, arg
)
797 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
801 /* If FRAME is nil, return a pointer to the selected frame.
802 Otherwise, check that FRAME is a live frame, and return a pointer
803 to it. NPARAM is the parameter number of FRAME, for
804 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
805 Lisp function definitions. */
807 static INLINE
struct frame
*
808 frame_or_selected_frame (frame
, nparam
)
813 frame
= selected_frame
;
815 CHECK_LIVE_FRAME (frame
, nparam
);
816 return XFRAME (frame
);
820 /***********************************************************************
822 ***********************************************************************/
824 /* Initialize face cache and basic faces for frame F. */
830 /* Make a face cache, if F doesn't have one. */
831 if (FRAME_FACE_CACHE (f
) == NULL
)
832 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
834 #ifdef HAVE_WINDOW_SYSTEM
835 /* Make the image cache. */
836 if (FRAME_WINDOW_P (f
))
838 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
839 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
840 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
842 #endif /* HAVE_WINDOW_SYSTEM */
844 /* Realize basic faces. Must have enough information in frame
845 parameters to realize basic faces at this point. */
846 #ifdef HAVE_X_WINDOWS
847 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
850 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
852 if (!realize_basic_faces (f
))
857 /* Free face cache of frame F. Called from Fdelete_frame. */
863 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
867 free_face_cache (face_cache
);
868 FRAME_FACE_CACHE (f
) = NULL
;
871 #ifdef HAVE_WINDOW_SYSTEM
872 if (FRAME_WINDOW_P (f
))
874 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
877 --image_cache
->refcount
;
878 if (image_cache
->refcount
== 0)
879 free_image_cache (f
);
882 #endif /* HAVE_WINDOW_SYSTEM */
886 /* Clear face caches, and recompute basic faces for frame F. Call
887 this after changing frame parameters on which those faces depend,
888 or when realized faces have been freed due to changing attributes
892 recompute_basic_faces (f
)
895 if (FRAME_FACE_CACHE (f
))
897 clear_face_cache (0);
898 if (!realize_basic_faces (f
))
904 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
905 try to free unused fonts, too. */
908 clear_face_cache (clear_fonts_p
)
911 #ifdef HAVE_WINDOW_SYSTEM
912 Lisp_Object tail
, frame
;
916 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
918 /* From time to time see if we can unload some fonts. This also
919 frees all realized faces on all frames. Fonts needed by
920 faces will be loaded again when faces are realized again. */
921 clear_font_table_count
= 0;
923 FOR_EACH_FRAME (tail
, frame
)
926 if (FRAME_WINDOW_P (f
)
927 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
929 free_all_realized_faces (frame
);
930 clear_font_table (f
);
936 /* Clear GCs of realized faces. */
937 FOR_EACH_FRAME (tail
, frame
)
940 if (FRAME_WINDOW_P (f
))
942 clear_face_gcs (FRAME_FACE_CACHE (f
));
943 clear_image_cache (f
, 0);
947 #endif /* HAVE_WINDOW_SYSTEM */
951 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
952 "Clear face caches on all frames.\n\
953 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
955 Lisp_Object thorougly
;
957 clear_face_cache (!NILP (thorougly
));
959 ++windows_or_buffers_changed
;
965 #ifdef HAVE_WINDOW_SYSTEM
968 /* Remove those fonts from the font table of frame F exept for the
969 default ASCII font for the frame. Called from clear_face_cache
970 from time to time. */
976 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
979 xassert (FRAME_WINDOW_P (f
));
981 /* Free those fonts that are not used by the frame F as the default. */
982 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
984 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
987 || font_info
->font
== FRAME_FONT (f
))
991 if (font_info
->full_name
!= font_info
->name
)
992 xfree (font_info
->full_name
);
993 xfree (font_info
->name
);
997 #ifdef HAVE_X_WINDOWS
998 XFreeFont (dpyinfo
->display
, font_info
->font
);
1001 w32_unload_font (dpyinfo
, font_info
->font
);
1005 /* Mark font table slot free. */
1006 font_info
->font
= NULL
;
1007 font_info
->name
= font_info
->full_name
= NULL
;
1011 #endif /* HAVE_WINDOW_SYSTEM */
1015 /***********************************************************************
1017 ***********************************************************************/
1019 #ifdef HAVE_WINDOW_SYSTEM
1021 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1022 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1023 A bitmap specification is either a string, a file name, or a list\n\
1024 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1025 HEIGHT is its height, and DATA is a string containing the bits of\n\
1026 the pixmap. Bits are stored row by row, each row occupies\n\
1027 (WIDTH + 7)/8 bytes.")
1033 if (STRINGP (object
))
1034 /* If OBJECT is a string, it's a file name. */
1036 else if (CONSP (object
))
1038 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1039 HEIGHT must be integers > 0, and DATA must be string large
1040 enough to hold a bitmap of the specified size. */
1041 Lisp_Object width
, height
, data
;
1043 height
= width
= data
= Qnil
;
1047 width
= XCAR (object
);
1048 object
= XCDR (object
);
1051 height
= XCAR (object
);
1052 object
= XCDR (object
);
1054 data
= XCAR (object
);
1058 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1060 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1062 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1067 return pixmap_p
? Qt
: Qnil
;
1071 /* Load a bitmap according to NAME (which is either a file name or a
1072 pixmap spec) for use on frame F. Value is the bitmap_id (see
1073 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1074 bitmap cannot be loaded, display a message saying so, and return
1075 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1076 if these pointers are not null. */
1079 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1082 unsigned int *w_ptr
, *h_ptr
;
1090 tem
= Fbitmap_spec_p (name
);
1092 wrong_type_argument (Qbitmap_spec_p
, name
);
1097 /* Decode a bitmap spec into a bitmap. */
1102 w
= XINT (Fcar (name
));
1103 h
= XINT (Fcar (Fcdr (name
)));
1104 bits
= Fcar (Fcdr (Fcdr (name
)));
1106 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1111 /* It must be a string -- a file name. */
1112 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1118 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1129 ++npixmaps_allocated
;
1132 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1135 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1141 #endif /* HAVE_WINDOW_SYSTEM */
1145 /***********************************************************************
1147 ***********************************************************************/
1149 #ifdef HAVE_WINDOW_SYSTEM
1151 /* Update the line_height of frame F. Return non-zero if line height
1155 frame_update_line_height (f
)
1158 int line_height
, changed_p
;
1160 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1161 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1162 FRAME_LINE_HEIGHT (f
) = line_height
;
1166 #endif /* HAVE_WINDOW_SYSTEM */
1169 /***********************************************************************
1171 ***********************************************************************/
1173 #ifdef HAVE_WINDOW_SYSTEM
1175 /* Load font of face FACE which is used on frame F to display
1176 character C. The name of the font to load is determined by lface
1177 and fontset of FACE. */
1180 load_face_font (f
, face
, c
)
1185 struct font_info
*font_info
= NULL
;
1188 face
->font_info_id
= -1;
1191 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1196 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1201 face
->font_info_id
= font_info
->font_idx
;
1202 face
->font
= font_info
->font
;
1203 face
->font_name
= font_info
->full_name
;
1206 x_free_gc (f
, face
->gc
);
1211 add_to_log ("Unable to load font %s",
1212 build_string (font_name
), Qnil
);
1216 #endif /* HAVE_WINDOW_SYSTEM */
1220 /***********************************************************************
1222 ***********************************************************************/
1224 /* A version of defined_color for non-X frames. */
1227 tty_defined_color (f
, color_name
, color_def
, alloc
)
1233 Lisp_Object color_desc
;
1234 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1235 unsigned long red
= 0, green
= 0, blue
= 0;
1238 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1242 XSETFRAME (frame
, f
);
1244 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1245 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1247 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1248 if (CONSP (XCDR (XCDR (color_desc
))))
1250 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1251 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1252 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1256 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1257 /* We were called early during startup, and the colors are not
1258 yet set up in tty-defined-color-alist. Don't return a failure
1259 indication, since this produces the annoying "Unable to
1260 load color" messages in the *Messages* buffer. */
1263 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1265 if (strcmp (color_name
, "unspecified-fg") == 0)
1266 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1267 else if (strcmp (color_name
, "unspecified-bg") == 0)
1268 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1271 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1274 color_def
->pixel
= color_idx
;
1275 color_def
->red
= red
;
1276 color_def
->green
= green
;
1277 color_def
->blue
= blue
;
1283 /* Decide if color named COLOR_NAME is valid for the display
1284 associated with the frame F; if so, return the rgb values in
1285 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1287 This does the right thing for any type of frame. */
1290 defined_color (f
, color_name
, color_def
, alloc
)
1296 if (!FRAME_WINDOW_P (f
))
1297 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1298 #ifdef HAVE_X_WINDOWS
1299 else if (FRAME_X_P (f
))
1300 return x_defined_color (f
, color_name
, color_def
, alloc
);
1303 else if (FRAME_W32_P (f
))
1304 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1307 else if (FRAME_MAC_P (f
))
1308 /* FIXME: mac_defined_color doesn't exist! */
1309 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1316 /* Given the index IDX of a tty color on frame F, return its name, a
1320 tty_color_name (f
, idx
)
1324 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1327 Lisp_Object coldesc
;
1329 XSETFRAME (frame
, f
);
1330 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1332 if (!NILP (coldesc
))
1333 return XCAR (coldesc
);
1336 /* We can have an MSDOG frame under -nw for a short window of
1337 opportunity before internal_terminal_init is called. DTRT. */
1338 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1339 return msdos_stdcolor_name (idx
);
1342 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1343 return build_string (unspecified_fg
);
1344 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1345 return build_string (unspecified_bg
);
1348 return vga_stdcolor_name (idx
);
1351 return Qunspecified
;
1355 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1356 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1359 face_color_gray_p (f
, color_name
)
1366 if (defined_color (f
, color_name
, &color
, 0))
1367 gray_p
= ((abs (color
.red
- color
.green
)
1368 < max (color
.red
, color
.green
) / 20)
1369 && (abs (color
.green
- color
.blue
)
1370 < max (color
.green
, color
.blue
) / 20)
1371 && (abs (color
.blue
- color
.red
)
1372 < max (color
.blue
, color
.red
) / 20));
1380 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1381 BACKGROUND_P non-zero means the color will be used as background
1385 face_color_supported_p (f
, color_name
, background_p
)
1393 XSETFRAME (frame
, f
);
1394 return (FRAME_WINDOW_P (f
)
1395 ? (!NILP (Fxw_display_color_p (frame
))
1396 || xstricmp (color_name
, "black") == 0
1397 || xstricmp (color_name
, "white") == 0
1399 && face_color_gray_p (f
, color_name
))
1400 || (!NILP (Fx_display_grayscale_p (frame
))
1401 && face_color_gray_p (f
, color_name
)))
1402 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1406 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1407 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1408 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1409 If FRAME is nil or omitted, use the selected frame.")
1411 Lisp_Object color
, frame
;
1415 CHECK_FRAME (frame
, 0);
1416 CHECK_STRING (color
, 0);
1418 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1422 DEFUN ("color-supported-p", Fcolor_supported_p
,
1423 Scolor_supported_p
, 2, 3, 0,
1424 "Return non-nil if COLOR can be displayed on FRAME.\n\
1425 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1426 If FRAME is nil or omitted, use the selected frame.\n\
1427 COLOR must be a valid color name.")
1428 (color
, frame
, background_p
)
1429 Lisp_Object frame
, color
, background_p
;
1433 CHECK_FRAME (frame
, 0);
1434 CHECK_STRING (color
, 0);
1436 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1442 /* Load color with name NAME for use by face FACE on frame F.
1443 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1444 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1445 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1446 pixel color. If color cannot be loaded, display a message, and
1447 return the foreground, background or underline color of F, but
1448 record that fact in flags of the face so that we don't try to free
1452 load_color (f
, face
, name
, target_index
)
1456 enum lface_attribute_index target_index
;
1460 xassert (STRINGP (name
));
1461 xassert (target_index
== LFACE_FOREGROUND_INDEX
1462 || target_index
== LFACE_BACKGROUND_INDEX
1463 || target_index
== LFACE_UNDERLINE_INDEX
1464 || target_index
== LFACE_OVERLINE_INDEX
1465 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1466 || target_index
== LFACE_BOX_INDEX
);
1468 /* if the color map is full, defined_color will return a best match
1469 to the values in an existing cell. */
1470 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1472 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1474 switch (target_index
)
1476 case LFACE_FOREGROUND_INDEX
:
1477 face
->foreground_defaulted_p
= 1;
1478 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1481 case LFACE_BACKGROUND_INDEX
:
1482 face
->background_defaulted_p
= 1;
1483 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1486 case LFACE_UNDERLINE_INDEX
:
1487 face
->underline_defaulted_p
= 1;
1488 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1491 case LFACE_OVERLINE_INDEX
:
1492 face
->overline_color_defaulted_p
= 1;
1493 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1496 case LFACE_STRIKE_THROUGH_INDEX
:
1497 face
->strike_through_color_defaulted_p
= 1;
1498 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1501 case LFACE_BOX_INDEX
:
1502 face
->box_color_defaulted_p
= 1;
1503 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1512 ++ncolors_allocated
;
1519 #ifdef HAVE_WINDOW_SYSTEM
1521 /* Load colors for face FACE which is used on frame F. Colors are
1522 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1523 of ATTRS. If the background color specified is not supported on F,
1524 try to emulate gray colors with a stipple from Vface_default_stipple. */
1527 load_face_colors (f
, face
, attrs
)
1534 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1535 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1537 /* Swap colors if face is inverse-video. */
1538 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1546 /* Check for support for foreground, not for background because
1547 face_color_supported_p is smart enough to know that grays are
1548 "supported" as background because we are supposed to use stipple
1550 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1551 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1553 x_destroy_bitmap (f
, face
->stipple
);
1554 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1555 &face
->pixmap_w
, &face
->pixmap_h
);
1558 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1559 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1563 /* Free color PIXEL on frame F. */
1566 unload_color (f
, pixel
)
1568 unsigned long pixel
;
1570 #ifdef HAVE_X_WINDOWS
1572 x_free_colors (f
, &pixel
, 1);
1578 /* Free colors allocated for FACE. */
1581 free_face_colors (f
, face
)
1585 #ifdef HAVE_X_WINDOWS
1588 if (!face
->foreground_defaulted_p
)
1590 x_free_colors (f
, &face
->foreground
, 1);
1591 IF_DEBUG (--ncolors_allocated
);
1594 if (!face
->background_defaulted_p
)
1596 x_free_colors (f
, &face
->background
, 1);
1597 IF_DEBUG (--ncolors_allocated
);
1600 if (face
->underline_p
1601 && !face
->underline_defaulted_p
)
1603 x_free_colors (f
, &face
->underline_color
, 1);
1604 IF_DEBUG (--ncolors_allocated
);
1607 if (face
->overline_p
1608 && !face
->overline_color_defaulted_p
)
1610 x_free_colors (f
, &face
->overline_color
, 1);
1611 IF_DEBUG (--ncolors_allocated
);
1614 if (face
->strike_through_p
1615 && !face
->strike_through_color_defaulted_p
)
1617 x_free_colors (f
, &face
->strike_through_color
, 1);
1618 IF_DEBUG (--ncolors_allocated
);
1621 if (face
->box
!= FACE_NO_BOX
1622 && !face
->box_color_defaulted_p
)
1624 x_free_colors (f
, &face
->box_color
, 1);
1625 IF_DEBUG (--ncolors_allocated
);
1629 #endif /* HAVE_X_WINDOWS */
1632 #endif /* HAVE_WINDOW_SYSTEM */
1636 /***********************************************************************
1638 ***********************************************************************/
1640 /* An enumerator for each field of an XLFD font name. */
1661 /* An enumerator for each possible slant value of a font. Taken from
1662 the XLFD specification. */
1670 XLFD_SLANT_REVERSE_ITALIC
,
1671 XLFD_SLANT_REVERSE_OBLIQUE
,
1675 /* Relative font weight according to XLFD documentation. */
1679 XLFD_WEIGHT_UNKNOWN
,
1680 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1681 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1682 XLFD_WEIGHT_LIGHT
, /* 30 */
1683 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1684 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1685 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1686 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1687 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1688 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1691 /* Relative proportionate width. */
1695 XLFD_SWIDTH_UNKNOWN
,
1696 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1697 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1698 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1699 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1700 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1701 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1702 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1703 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1704 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1707 /* Structure used for tables mapping XLFD weight, slant, and width
1708 names to numeric and symbolic values. */
1714 Lisp_Object
*symbol
;
1717 /* Table of XLFD slant names and their numeric and symbolic
1718 representations. This table must be sorted by slant names in
1721 static struct table_entry slant_table
[] =
1723 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1724 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1725 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1726 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1727 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1728 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1731 /* Table of XLFD weight names. This table must be sorted by weight
1732 names in ascending order. */
1734 static struct table_entry weight_table
[] =
1736 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1737 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1738 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1739 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1740 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1741 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1742 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1743 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1744 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1745 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1746 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1747 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1748 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1749 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1750 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1753 /* Table of XLFD width names. This table must be sorted by width
1754 names in ascending order. */
1756 static struct table_entry swidth_table
[] =
1758 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1759 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1760 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1761 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1762 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1763 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1764 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1765 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1766 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1767 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1768 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1769 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1770 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1771 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1772 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1775 /* Structure used to hold the result of splitting font names in XLFD
1776 format into their fields. */
1780 /* The original name which is modified destructively by
1781 split_font_name. The pointer is kept here to be able to free it
1782 if it was allocated from the heap. */
1785 /* Font name fields. Each vector element points into `name' above.
1786 Fields are NUL-terminated. */
1787 char *fields
[XLFD_LAST
];
1789 /* Numeric values for those fields that interest us. See
1790 split_font_name for which these are. */
1791 int numeric
[XLFD_LAST
];
1794 /* The frame in effect when sorting font names. Set temporarily in
1795 sort_fonts so that it is available in font comparison functions. */
1797 static struct frame
*font_frame
;
1799 /* Order by which font selection chooses fonts. The default values
1800 mean `first, find a best match for the font width, then for the
1801 font height, then for weight, then for slant.' This variable can be
1802 set via set-face-font-sort-order. */
1804 static int font_sort_order
[4];
1807 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1808 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1809 is a pointer to the matching table entry or null if no table entry
1812 static struct table_entry
*
1813 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1814 struct table_entry
*table
;
1816 struct font_name
*font
;
1819 /* Function split_font_name converts fields to lower-case, so there
1820 is no need to use xstrlwr or xstricmp here. */
1821 char *s
= font
->fields
[field_index
];
1822 int low
, mid
, high
, cmp
;
1829 mid
= (low
+ high
) / 2;
1830 cmp
= strcmp (table
[mid
].name
, s
);
1844 /* Return a numeric representation for font name field
1845 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1846 has DIM entries. Value is the numeric value found or DFLT if no
1847 table entry matches. This function is used to translate weight,
1848 slant, and swidth names of XLFD font names to numeric values. */
1851 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1852 struct table_entry
*table
;
1854 struct font_name
*font
;
1858 struct table_entry
*p
;
1859 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1860 return p
? p
->numeric
: dflt
;
1864 /* Return a symbolic representation for font name field
1865 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1866 has DIM entries. Value is the symbolic value found or DFLT if no
1867 table entry matches. This function is used to translate weight,
1868 slant, and swidth names of XLFD font names to symbols. */
1870 static INLINE Lisp_Object
1871 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1872 struct table_entry
*table
;
1874 struct font_name
*font
;
1878 struct table_entry
*p
;
1879 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1880 return p
? *p
->symbol
: dflt
;
1884 /* Return a numeric value for the slant of the font given by FONT. */
1887 xlfd_numeric_slant (font
)
1888 struct font_name
*font
;
1890 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1891 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1895 /* Return a symbol representing the weight of the font given by FONT. */
1897 static INLINE Lisp_Object
1898 xlfd_symbolic_slant (font
)
1899 struct font_name
*font
;
1901 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1902 font
, XLFD_SLANT
, Qnormal
);
1906 /* Return a numeric value for the weight of the font given by FONT. */
1909 xlfd_numeric_weight (font
)
1910 struct font_name
*font
;
1912 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1913 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1917 /* Return a symbol representing the slant of the font given by FONT. */
1919 static INLINE Lisp_Object
1920 xlfd_symbolic_weight (font
)
1921 struct font_name
*font
;
1923 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1924 font
, XLFD_WEIGHT
, Qnormal
);
1928 /* Return a numeric value for the swidth of the font whose XLFD font
1929 name fields are found in FONT. */
1932 xlfd_numeric_swidth (font
)
1933 struct font_name
*font
;
1935 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1936 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1940 /* Return a symbolic value for the swidth of FONT. */
1942 static INLINE Lisp_Object
1943 xlfd_symbolic_swidth (font
)
1944 struct font_name
*font
;
1946 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1947 font
, XLFD_SWIDTH
, Qnormal
);
1951 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1952 entries. Value is a pointer to the matching table entry or null if
1953 no element of TABLE contains SYMBOL. */
1955 static struct table_entry
*
1956 face_value (table
, dim
, symbol
)
1957 struct table_entry
*table
;
1963 xassert (SYMBOLP (symbol
));
1965 for (i
= 0; i
< dim
; ++i
)
1966 if (EQ (*table
[i
].symbol
, symbol
))
1969 return i
< dim
? table
+ i
: NULL
;
1973 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1974 entries. Value is -1 if SYMBOL is not found in TABLE. */
1977 face_numeric_value (table
, dim
, symbol
)
1978 struct table_entry
*table
;
1982 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1983 return p
? p
->numeric
: -1;
1987 /* Return a numeric value representing the weight specified by Lisp
1988 symbol WEIGHT. Value is one of the enumerators of enum
1992 face_numeric_weight (weight
)
1995 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1999 /* Return a numeric value representing the slant specified by Lisp
2000 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2003 face_numeric_slant (slant
)
2006 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2010 /* Return a numeric value representing the swidth specified by Lisp
2011 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2014 face_numeric_swidth (width
)
2017 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2021 #ifdef HAVE_WINDOW_SYSTEM
2023 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2027 struct font_name
*font
;
2029 /* Function split_font_name converts fields to lower-case, so there
2030 is no need to use tolower here. */
2031 return *font
->fields
[XLFD_SPACING
] != 'p';
2035 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2037 The actual height of the font when displayed on F depends on the
2038 resolution of both the font and frame. For example, a 10pt font
2039 designed for a 100dpi display will display larger than 10pt on a
2040 75dpi display. (It's not unusual to use fonts not designed for the
2041 display one is using. For example, some intlfonts are available in
2042 72dpi versions, only.)
2044 Value is the real point size of FONT on frame F, or 0 if it cannot
2048 xlfd_point_size (f
, font
)
2050 struct font_name
*font
;
2052 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2053 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2054 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2057 if (font_resy
== 0 || font_pt
== 0)
2060 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2066 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2067 of frame F. This function is used to guess a point size of font
2068 when only the pixel height of the font is available. */
2071 pixel_point_size (f
, pixel
)
2075 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2079 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2080 real_pt
= pixel
* 72 / resy
;
2081 int_pt
= real_pt
+ 0.5;
2087 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2088 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2089 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2090 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2091 zero if the font name doesn't have the format we expect. The
2092 expected format is a font name that starts with a `-' and has
2093 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2094 forms of font names where certain field contents are enclosed in
2095 square brackets. We don't support that, for now. */
2098 split_font_name (f
, font
, numeric_p
)
2100 struct font_name
*font
;
2106 if (*font
->name
== '-')
2108 char *p
= xstrlwr (font
->name
) + 1;
2110 while (i
< XLFD_LAST
)
2112 font
->fields
[i
] = p
;
2115 while (*p
&& *p
!= '-')
2125 success_p
= i
== XLFD_LAST
;
2127 /* If requested, and font name was in the expected format,
2128 compute numeric values for some fields. */
2129 if (numeric_p
&& success_p
)
2131 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2132 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2133 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2134 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2135 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2142 /* Build an XLFD font name from font name fields in FONT. Value is a
2143 pointer to the font name, which is allocated via xmalloc. */
2146 build_font_name (font
)
2147 struct font_name
*font
;
2151 char *font_name
= (char *) xmalloc (size
);
2152 int total_length
= 0;
2154 for (i
= 0; i
< XLFD_LAST
; ++i
)
2156 /* Add 1 because of the leading `-'. */
2157 int len
= strlen (font
->fields
[i
]) + 1;
2159 /* Reallocate font_name if necessary. Add 1 for the final
2161 if (total_length
+ len
+ 1 >= size
)
2163 int new_size
= max (2 * size
, size
+ len
+ 1);
2164 int sz
= new_size
* sizeof *font_name
;
2165 font_name
= (char *) xrealloc (font_name
, sz
);
2169 font_name
[total_length
] = '-';
2170 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2171 total_length
+= len
;
2174 font_name
[total_length
] = 0;
2179 /* Free an array FONTS of N font_name structures. This frees FONTS
2180 itself and all `name' fields in its elements. */
2183 free_font_names (fonts
, n
)
2184 struct font_name
*fonts
;
2188 xfree (fonts
[--n
].name
);
2193 /* Sort vector FONTS of font_name structures which contains NFONTS
2194 elements using qsort and comparison function CMPFN. F is the frame
2195 on which the fonts will be used. The global variable font_frame
2196 is temporarily set to F to make it available in CMPFN. */
2199 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2201 struct font_name
*fonts
;
2203 int (*cmpfn
) P_ ((const void *, const void *));
2206 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2211 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2212 display in x_display_list. FONTS is a pointer to a vector of
2213 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2214 alternative patterns from Valternate_fontname_alist if no fonts are
2215 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2218 For all fonts found, set FONTS[i].name to the name of the font,
2219 allocated via xmalloc, and split font names into fields. Ignore
2220 fonts that we can't parse. Value is the number of fonts found.
2222 This is similar to x_list_fonts. The differences are:
2224 1. It avoids consing.
2225 2. It never calls XLoadQueryFont. */
2228 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2232 struct font_name
*fonts
;
2233 int nfonts
, try_alternatives_p
;
2234 int scalable_fonts_p
;
2238 #ifdef HAVE_X_WINDOWS
2239 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2241 /* Get the list of fonts matching PATTERN from the X server. */
2243 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2247 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2248 better to do it the other way around. */
2250 Lisp_Object lpattern
, tem
;
2255 lpattern
= build_string (pattern
);
2257 /* Get the list of fonts matching PATTERN. */
2259 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2262 /* Count fonts returned */
2263 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2266 /* Allocate array. */
2268 names
= (char **) xmalloc (n
* sizeof (char *));
2270 /* Extract font names into char * array. */
2272 for (i
= 0; i
< n
; i
++)
2274 names
[i
] = XSTRING (XCAR (tem
))->data
;
2281 /* Make a copy of the font names we got from X, and
2282 split them into fields. */
2283 for (i
= j
= 0; i
< n
; ++i
)
2285 /* Make a copy of the font name. */
2286 fonts
[j
].name
= xstrdup (names
[i
]);
2288 /* Ignore fonts having a name that we can't parse. */
2289 if (!split_font_name (f
, fonts
+ j
, 1))
2290 xfree (fonts
[j
].name
);
2291 else if (font_scalable_p (fonts
+ j
))
2294 if (!scalable_fonts_p
2295 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2296 xfree (fonts
[j
].name
);
2299 #else /* !SCALABLE_FONTS */
2300 /* Always ignore scalable fonts. */
2301 xfree (fonts
[j
].name
);
2302 #endif /* !SCALABLE_FONTS */
2310 #ifdef HAVE_X_WINDOWS
2311 /* Free font names. */
2313 XFreeFontNames (names
);
2319 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2320 if (n
== 0 && try_alternatives_p
)
2322 Lisp_Object list
= Valternate_fontname_alist
;
2324 while (CONSP (list
))
2326 Lisp_Object entry
= XCAR (list
);
2328 && STRINGP (XCAR (entry
))
2329 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2336 Lisp_Object patterns
= XCAR (list
);
2339 while (CONSP (patterns
)
2340 /* If list is screwed up, give up. */
2341 && (name
= XCAR (patterns
),
2343 /* Ignore patterns equal to PATTERN because we tried that
2344 already with no success. */
2345 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2346 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2350 patterns
= XCDR (patterns
);
2358 /* Determine the first font matching PATTERN on frame F. Return in
2359 *FONT the matching font name, split into fields. Value is non-zero
2360 if a match was found. */
2363 first_font_matching (f
, pattern
, font
)
2366 struct font_name
*font
;
2369 struct font_name
*fonts
;
2371 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2372 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2376 bcopy (&fonts
[0], font
, sizeof *font
);
2378 fonts
[0].name
= NULL
;
2379 free_font_names (fonts
, nfonts
);
2386 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2387 using comparison function CMPFN. Value is the number of fonts
2388 found. If value is non-zero, *FONTS is set to a vector of
2389 font_name structures allocated from the heap containing matching
2390 fonts. Each element of *FONTS contains a name member that is also
2391 allocated from the heap. Font names in these structures are split
2392 into fields. Use free_font_names to free such an array. */
2395 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2398 int (*cmpfn
) P_ ((const void *, const void *));
2399 struct font_name
**fonts
;
2403 /* Get the list of fonts matching pattern. 100 should suffice. */
2404 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2405 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2406 nfonts
= XFASTINT (Vfont_list_limit
);
2408 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2410 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2412 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2415 /* Sort the resulting array and return it in *FONTS. If no
2416 fonts were found, make sure to set *FONTS to null. */
2418 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2429 /* Compare two font_name structures *A and *B. Value is analogous to
2430 strcmp. Sort order is given by the global variable
2431 font_sort_order. Font names are sorted so that, everything else
2432 being equal, fonts with a resolution closer to that of the frame on
2433 which they are used are listed first. The global variable
2434 font_frame is the frame on which we operate. */
2437 cmp_font_names (a
, b
)
2440 struct font_name
*x
= (struct font_name
*) a
;
2441 struct font_name
*y
= (struct font_name
*) b
;
2444 /* All strings have been converted to lower-case by split_font_name,
2445 so we can use strcmp here. */
2446 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2451 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2453 int j
= font_sort_order
[i
];
2454 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2459 /* Everything else being equal, we prefer fonts with an
2460 y-resolution closer to that of the frame. */
2461 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2462 int x_resy
= x
->numeric
[XLFD_RESY
];
2463 int y_resy
= y
->numeric
[XLFD_RESY
];
2464 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2472 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2473 is non-nil list fonts matching that pattern. Otherwise, if
2474 REGISTRY is non-nil return only fonts with that registry, otherwise
2475 return fonts of any registry. Set *FONTS to a vector of font_name
2476 structures allocated from the heap containing the fonts found.
2477 Value is the number of fonts found. */
2480 font_list (f
, pattern
, family
, registry
, fonts
)
2482 Lisp_Object pattern
, family
, registry
;
2483 struct font_name
**fonts
;
2485 char *pattern_str
, *family_str
, *registry_str
;
2489 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2490 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2492 pattern_str
= (char *) alloca (strlen (family_str
)
2493 + strlen (registry_str
)
2495 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2496 strcat (pattern_str
, family_str
);
2497 strcat (pattern_str
, "-*-");
2498 strcat (pattern_str
, registry_str
);
2499 if (!index (registry_str
, '-'))
2501 if (registry_str
[strlen (registry_str
) - 1] == '*')
2502 strcat (pattern_str
, "-*");
2504 strcat (pattern_str
, "*-*");
2508 pattern_str
= (char *) XSTRING (pattern
)->data
;
2510 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2514 /* Remove elements from LIST whose cars are `equal'. Called from
2515 x-family-fonts and x-font-family-list to remove duplicate font
2519 remove_duplicates (list
)
2522 Lisp_Object tail
= list
;
2524 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2526 Lisp_Object next
= XCDR (tail
);
2527 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2528 XCDR (tail
) = XCDR (next
);
2535 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2536 "Return a list of available fonts of family FAMILY on FRAME.\n\
2537 If FAMILY is omitted or nil, list all families.\n\
2538 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2540 If FRAME is omitted or nil, use the selected frame.\n\
2541 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2542 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2543 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2544 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2545 width, weight and slant of the font. These symbols are the same as for\n\
2546 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2547 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2548 giving the registry and encoding of the font.\n\
2549 The result list is sorted according to the current setting of\n\
2550 the face font sort order.")
2552 Lisp_Object family
, frame
;
2554 struct frame
*f
= check_x_frame (frame
);
2555 struct font_name
*fonts
;
2558 struct gcpro gcpro1
;
2561 CHECK_STRING (family
, 1);
2565 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2566 for (i
= nfonts
- 1; i
>= 0; --i
)
2568 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2571 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2572 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2573 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2574 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2575 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2576 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2577 tem
= build_font_name (fonts
+ i
);
2578 ASET (v
, 6, build_string (tem
));
2579 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2580 fonts
[i
].fields
[XLFD_ENCODING
]);
2581 ASET (v
, 7, build_string (tem
));
2584 result
= Fcons (v
, result
);
2587 remove_duplicates (result
);
2588 free_font_names (fonts
, nfonts
);
2594 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2596 "Return a list of available font families on FRAME.\n\
2597 If FRAME is omitted or nil, use the selected frame.\n\
2598 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2599 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2604 struct frame
*f
= check_x_frame (frame
);
2606 struct font_name
*fonts
;
2608 struct gcpro gcpro1
;
2609 int count
= specpdl_ptr
- specpdl
;
2612 /* Let's consider all fonts. Increase the limit for matching
2613 fonts until we have them all. */
2616 specbind (intern ("font-list-limit"), make_number (limit
));
2617 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2619 if (nfonts
== limit
)
2621 free_font_names (fonts
, nfonts
);
2630 for (i
= nfonts
- 1; i
>= 0; --i
)
2631 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2632 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2635 remove_duplicates (result
);
2636 free_font_names (fonts
, nfonts
);
2638 return unbind_to (count
, result
);
2642 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2643 "Return a list of the names of available fonts matching PATTERN.\n\
2644 If optional arguments FACE and FRAME are specified, return only fonts\n\
2645 the same size as FACE on FRAME.\n\
2646 PATTERN is a string, perhaps with wildcard characters;\n\
2647 the * character matches any substring, and\n\
2648 the ? character matches any single character.\n\
2649 PATTERN is case-insensitive.\n\
2650 FACE is a face name--a symbol.\n\
2652 The return value is a list of strings, suitable as arguments to\n\
2655 Fonts Emacs can't use may or may not be excluded\n\
2656 even if they match PATTERN and FACE.\n\
2657 The optional fourth argument MAXIMUM sets a limit on how many\n\
2658 fonts to match. The first MAXIMUM fonts are reported.\n\
2659 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2660 occupied by a character of a font. In that case, return only fonts\n\
2661 the WIDTH times as wide as FACE on FRAME.")
2662 (pattern
, face
, frame
, maximum
, width
)
2663 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2670 CHECK_STRING (pattern
, 0);
2676 CHECK_NATNUM (maximum
, 0);
2677 maxnames
= XINT (maximum
);
2681 CHECK_NUMBER (width
, 4);
2683 /* We can't simply call check_x_frame because this function may be
2684 called before any frame is created. */
2685 f
= frame_or_selected_frame (frame
, 2);
2686 if (!FRAME_WINDOW_P (f
))
2688 /* Perhaps we have not yet created any frame. */
2693 /* Determine the width standard for comparison with the fonts we find. */
2699 /* This is of limited utility since it works with character
2700 widths. Keep it for compatibility. --gerd. */
2701 int face_id
= lookup_named_face (f
, face
, 0);
2702 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2705 size
= FONT_WIDTH (face
->font
);
2707 size
= FONT_WIDTH (FRAME_FONT (f
));
2710 size
*= XINT (width
);
2714 Lisp_Object args
[2];
2716 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2718 /* We don't have to check fontsets. */
2720 args
[1] = list_fontsets (f
, pattern
, size
);
2721 return Fnconc (2, args
);
2725 #endif /* HAVE_WINDOW_SYSTEM */
2729 /***********************************************************************
2731 ***********************************************************************/
2733 /* Access face attributes of face FACE, a Lisp vector. */
2735 #define LFACE_FAMILY(LFACE) \
2736 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2737 #define LFACE_HEIGHT(LFACE) \
2738 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2739 #define LFACE_WEIGHT(LFACE) \
2740 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2741 #define LFACE_SLANT(LFACE) \
2742 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2743 #define LFACE_UNDERLINE(LFACE) \
2744 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2745 #define LFACE_INVERSE(LFACE) \
2746 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2747 #define LFACE_FOREGROUND(LFACE) \
2748 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2749 #define LFACE_BACKGROUND(LFACE) \
2750 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2751 #define LFACE_STIPPLE(LFACE) \
2752 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2753 #define LFACE_SWIDTH(LFACE) \
2754 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2755 #define LFACE_OVERLINE(LFACE) \
2756 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2757 #define LFACE_STRIKE_THROUGH(LFACE) \
2758 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2759 #define LFACE_BOX(LFACE) \
2760 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2761 #define LFACE_FONT(LFACE) \
2762 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2764 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2765 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2767 #define LFACEP(LFACE) \
2769 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2770 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2775 /* Check consistency of Lisp face attribute vector ATTRS. */
2778 check_lface_attrs (attrs
)
2781 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2782 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2783 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2784 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2785 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2786 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2787 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2788 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2789 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2790 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2791 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2792 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2793 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2794 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2795 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2796 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2797 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2798 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2799 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2800 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2801 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2802 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2803 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2804 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2805 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2806 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2807 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2808 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2809 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2810 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2811 #ifdef HAVE_WINDOW_SYSTEM
2812 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2813 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2814 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2815 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2816 || NILP (attrs
[LFACE_FONT_INDEX
])
2817 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2822 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2830 xassert (LFACEP (lface
));
2831 check_lface_attrs (XVECTOR (lface
)->contents
);
2835 #else /* GLYPH_DEBUG == 0 */
2837 #define check_lface_attrs(attrs) (void) 0
2838 #define check_lface(lface) (void) 0
2840 #endif /* GLYPH_DEBUG == 0 */
2843 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2844 to make it a symvol. If FACE_NAME is an alias for another face,
2845 return that face's name. */
2848 resolve_face_name (face_name
)
2849 Lisp_Object face_name
;
2851 Lisp_Object aliased
;
2853 if (STRINGP (face_name
))
2854 face_name
= intern (XSTRING (face_name
)->data
);
2858 aliased
= Fget (face_name
, Qface_alias
);
2862 face_name
= aliased
;
2869 /* Return the face definition of FACE_NAME on frame F. F null means
2870 return the global definition. FACE_NAME may be a string or a
2871 symbol (apparently Emacs 20.2 allows strings as face names in face
2872 text properties; ediff uses that). If FACE_NAME is an alias for
2873 another face, return that face's definition. If SIGNAL_P is
2874 non-zero, signal an error if FACE_NAME is not a valid face name.
2875 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2878 static INLINE Lisp_Object
2879 lface_from_face_name (f
, face_name
, signal_p
)
2881 Lisp_Object face_name
;
2886 face_name
= resolve_face_name (face_name
);
2889 lface
= assq_no_quit (face_name
, f
->face_alist
);
2891 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2894 lface
= XCDR (lface
);
2896 signal_error ("Invalid face", face_name
);
2898 check_lface (lface
);
2903 /* Get face attributes of face FACE_NAME from frame-local faces on
2904 frame F. Store the resulting attributes in ATTRS which must point
2905 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2906 is non-zero, signal an error if FACE_NAME does not name a face.
2907 Otherwise, value is zero if FACE_NAME is not a face. */
2910 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2912 Lisp_Object face_name
;
2919 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2922 bcopy (XVECTOR (lface
)->contents
, attrs
,
2923 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2933 /* Non-zero if all attributes in face attribute vector ATTRS are
2934 specified, i.e. are non-nil. */
2937 lface_fully_specified_p (attrs
)
2942 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2943 if (UNSPECIFIEDP (attrs
[i
]) && i
!= LFACE_FONT_INDEX
)
2946 return i
== LFACE_VECTOR_SIZE
;
2949 #ifdef HAVE_WINDOW_SYSTEM
2951 /* Set font-related attributes of Lisp face LFACE from the fullname of
2952 the font opened by FONTNAME. If FORCE_P is zero, set only
2953 unspecified attributes of LFACE. The exception is `font'
2954 attribute. It is set to FONTNAME as is regardless of FORCE_P.
2956 If FONTNAME is not available on frame F,
2957 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
2958 If the fullname is not in a valid XLFD format,
2959 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
2960 in LFACE and return 1.
2961 Otherwise, return 1. */
2964 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
2967 Lisp_Object fontname
;
2968 int force_p
, may_fail_p
;
2970 struct font_name font
;
2975 char *font_name
= XSTRING (fontname
)->data
;
2976 struct font_info
*font_info
;
2978 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
2979 fontset
= fs_query_fontset (fontname
, 0);
2981 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
2983 /* Check if FONT_NAME is surely available on the system. Usually
2984 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
2985 returns quickly. But, even if FONT_NAME is not yet cached,
2986 caching it now is not futail because we anyway load the font
2989 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
2999 font
.name
= STRDUPA (font_info
->full_name
);
3000 have_xlfd_p
= split_font_name (f
, &font
, 1);
3002 /* Set attributes only if unspecified, otherwise face defaults for
3003 new frames would never take effect. If we couldn't get a font
3004 name conforming to XLFD, set normal values. */
3006 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3011 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3012 + strlen (font
.fields
[XLFD_FOUNDRY
])
3014 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3015 font
.fields
[XLFD_FAMILY
]);
3016 val
= build_string (buffer
);
3019 val
= build_string ("*");
3020 LFACE_FAMILY (lface
) = val
;
3023 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3026 pt
= xlfd_point_size (f
, &font
);
3028 pt
= pixel_point_size (f
, font_info
->height
* 10);
3030 LFACE_HEIGHT (lface
) = make_number (pt
);
3033 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3034 LFACE_SWIDTH (lface
)
3035 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3037 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3038 LFACE_WEIGHT (lface
)
3039 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3041 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3043 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3045 LFACE_FONT (lface
) = fontname
;
3049 #endif /* HAVE_WINDOW_SYSTEM */
3052 /* Merge two Lisp face attribute vectors FROM and TO and store the
3053 resulting attributes in TO. Every non-nil attribute of FROM
3054 overrides the corresponding attribute of TO. */
3057 merge_face_vectors (from
, to
)
3058 Lisp_Object
*from
, *to
;
3061 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3062 if (!UNSPECIFIEDP (from
[i
]))
3067 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3068 is a face property, determine the resulting face attributes on
3069 frame F, and store them in TO. PROP may be a single face
3070 specification or a list of such specifications. Each face
3071 specification can be
3073 1. A symbol or string naming a Lisp face.
3075 2. A property list of the form (KEYWORD VALUE ...) where each
3076 KEYWORD is a face attribute name, and value is an appropriate value
3079 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3080 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3081 for compatibility with 20.2.
3083 Face specifications earlier in lists take precedence over later
3087 merge_face_vector_with_property (f
, to
, prop
)
3094 Lisp_Object first
= XCAR (prop
);
3096 if (EQ (first
, Qforeground_color
)
3097 || EQ (first
, Qbackground_color
))
3099 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3100 . COLOR). COLOR must be a string. */
3101 Lisp_Object color_name
= XCDR (prop
);
3102 Lisp_Object color
= first
;
3104 if (STRINGP (color_name
))
3106 if (EQ (color
, Qforeground_color
))
3107 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3109 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3112 add_to_log ("Invalid face color", color_name
, Qnil
);
3114 else if (SYMBOLP (first
)
3115 && *XSYMBOL (first
)->name
->data
== ':')
3117 /* Assume this is the property list form. */
3118 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3120 Lisp_Object keyword
= XCAR (prop
);
3121 Lisp_Object value
= XCAR (XCDR (prop
));
3123 if (EQ (keyword
, QCfamily
))
3125 if (STRINGP (value
))
3126 to
[LFACE_FAMILY_INDEX
] = value
;
3128 add_to_log ("Invalid face font family", value
, Qnil
);
3130 else if (EQ (keyword
, QCheight
))
3132 if (INTEGERP (value
))
3133 to
[LFACE_HEIGHT_INDEX
] = value
;
3135 add_to_log ("Invalid face font height", value
, Qnil
);
3137 else if (EQ (keyword
, QCweight
))
3140 && face_numeric_weight (value
) >= 0)
3141 to
[LFACE_WEIGHT_INDEX
] = value
;
3143 add_to_log ("Invalid face weight", value
, Qnil
);
3145 else if (EQ (keyword
, QCslant
))
3148 && face_numeric_slant (value
) >= 0)
3149 to
[LFACE_SLANT_INDEX
] = value
;
3151 add_to_log ("Invalid face slant", value
, Qnil
);
3153 else if (EQ (keyword
, QCunderline
))
3158 to
[LFACE_UNDERLINE_INDEX
] = value
;
3160 add_to_log ("Invalid face underline", value
, Qnil
);
3162 else if (EQ (keyword
, QCoverline
))
3167 to
[LFACE_OVERLINE_INDEX
] = value
;
3169 add_to_log ("Invalid face overline", value
, Qnil
);
3171 else if (EQ (keyword
, QCstrike_through
))
3176 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3178 add_to_log ("Invalid face strike-through", value
, Qnil
);
3180 else if (EQ (keyword
, QCbox
))
3183 value
= make_number (1);
3184 if (INTEGERP (value
)
3188 to
[LFACE_BOX_INDEX
] = value
;
3190 add_to_log ("Invalid face box", value
, Qnil
);
3192 else if (EQ (keyword
, QCinverse_video
)
3193 || EQ (keyword
, QCreverse_video
))
3195 if (EQ (value
, Qt
) || NILP (value
))
3196 to
[LFACE_INVERSE_INDEX
] = value
;
3198 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3200 else if (EQ (keyword
, QCforeground
))
3202 if (STRINGP (value
))
3203 to
[LFACE_FOREGROUND_INDEX
] = value
;
3205 add_to_log ("Invalid face foreground", value
, Qnil
);
3207 else if (EQ (keyword
, QCbackground
))
3209 if (STRINGP (value
))
3210 to
[LFACE_BACKGROUND_INDEX
] = value
;
3212 add_to_log ("Invalid face background", value
, Qnil
);
3214 else if (EQ (keyword
, QCstipple
))
3216 #ifdef HAVE_X_WINDOWS
3217 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3218 if (!NILP (pixmap_p
))
3219 to
[LFACE_STIPPLE_INDEX
] = value
;
3221 add_to_log ("Invalid face stipple", value
, Qnil
);
3224 else if (EQ (keyword
, QCwidth
))
3227 && face_numeric_swidth (value
) >= 0)
3228 to
[LFACE_SWIDTH_INDEX
] = value
;
3230 add_to_log ("Invalid face width", value
, Qnil
);
3233 add_to_log ("Invalid attribute %s in face property",
3236 prop
= XCDR (XCDR (prop
));
3241 /* This is a list of face specs. Specifications at the
3242 beginning of the list take precedence over later
3243 specifications, so we have to merge starting with the
3244 last specification. */
3245 Lisp_Object next
= XCDR (prop
);
3247 merge_face_vector_with_property (f
, to
, next
);
3248 merge_face_vector_with_property (f
, to
, first
);
3253 /* PROP ought to be a face name. */
3254 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3256 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3258 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3263 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3264 Sinternal_make_lisp_face
, 1, 2, 0,
3265 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3266 If FACE was not known as a face before, create a new one.\n\
3267 If optional argument FRAME is specified, make a frame-local face\n\
3268 for that frame. Otherwise operate on the global face definition.\n\
3269 Value is a vector of face attributes.")
3271 Lisp_Object face
, frame
;
3273 Lisp_Object global_lface
, lface
;
3277 CHECK_SYMBOL (face
, 0);
3278 global_lface
= lface_from_face_name (NULL
, face
, 0);
3282 CHECK_LIVE_FRAME (frame
, 1);
3284 lface
= lface_from_face_name (f
, face
, 0);
3287 f
= NULL
, lface
= Qnil
;
3289 /* Add a global definition if there is none. */
3290 if (NILP (global_lface
))
3292 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3294 XVECTOR (global_lface
)->contents
[0] = Qface
;
3295 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3296 Vface_new_frame_defaults
);
3298 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3299 face id to Lisp face is given by the vector lface_id_to_name.
3300 The mapping from Lisp face to Lisp face id is given by the
3301 property `face' of the Lisp face name. */
3302 if (next_lface_id
== lface_id_to_name_size
)
3304 int new_size
= max (50, 2 * lface_id_to_name_size
);
3305 int sz
= new_size
* sizeof *lface_id_to_name
;
3306 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3307 lface_id_to_name_size
= new_size
;
3310 lface_id_to_name
[next_lface_id
] = face
;
3311 Fput (face
, Qface
, make_number (next_lface_id
));
3315 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3316 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3318 /* Add a frame-local definition. */
3323 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3325 XVECTOR (lface
)->contents
[0] = Qface
;
3326 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3329 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3330 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3333 lface
= global_lface
;
3335 xassert (LFACEP (lface
));
3336 check_lface (lface
);
3341 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3342 Sinternal_lisp_face_p
, 1, 2, 0,
3343 "Return non-nil if FACE names a face.\n\
3344 If optional second parameter FRAME is non-nil, check for the\n\
3345 existence of a frame-local face with name FACE on that frame.\n\
3346 Otherwise check for the existence of a global face.")
3348 Lisp_Object face
, frame
;
3354 CHECK_LIVE_FRAME (frame
, 1);
3355 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3358 lface
= lface_from_face_name (NULL
, face
, 0);
3364 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3365 Sinternal_copy_lisp_face
, 4, 4, 0,
3366 "Copy face FROM to TO.\n\
3367 If FRAME it t, copy the global face definition of FROM to the\n\
3368 global face definition of TO. Otherwise, copy the frame-local\n\
3369 definition of FROM on FRAME to the frame-local definition of TO\n\
3370 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3373 (from
, to
, frame
, new_frame
)
3374 Lisp_Object from
, to
, frame
, new_frame
;
3376 Lisp_Object lface
, copy
;
3378 CHECK_SYMBOL (from
, 0);
3379 CHECK_SYMBOL (to
, 1);
3380 if (NILP (new_frame
))
3385 /* Copy global definition of FROM. We don't make copies of
3386 strings etc. because 20.2 didn't do it either. */
3387 lface
= lface_from_face_name (NULL
, from
, 1);
3388 copy
= Finternal_make_lisp_face (to
, Qnil
);
3392 /* Copy frame-local definition of FROM. */
3393 CHECK_LIVE_FRAME (frame
, 2);
3394 CHECK_LIVE_FRAME (new_frame
, 3);
3395 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3396 copy
= Finternal_make_lisp_face (to
, new_frame
);
3399 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3400 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3406 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3407 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3408 "Set attribute ATTR of FACE to VALUE.\n\
3409 If optional argument FRAME is given, set the face attribute of face FACE\n\
3410 on that frame. If FRAME is t, set the attribute of the default for face\n\
3411 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3413 (face
, attr
, value
, frame
)
3414 Lisp_Object face
, attr
, value
, frame
;
3417 Lisp_Object old_value
= Qnil
;
3418 /* Set 1 if ATTR is QCfont. */
3419 int font_attr_p
= 0;
3420 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3421 int font_related_attr_p
= 0;
3423 CHECK_SYMBOL (face
, 0);
3424 CHECK_SYMBOL (attr
, 1);
3426 face
= resolve_face_name (face
);
3428 /* Set lface to the Lisp attribute vector of FACE. */
3430 lface
= lface_from_face_name (NULL
, face
, 1);
3434 frame
= selected_frame
;
3436 CHECK_LIVE_FRAME (frame
, 3);
3437 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3439 /* If a frame-local face doesn't exist yet, create one. */
3441 lface
= Finternal_make_lisp_face (face
, frame
);
3444 if (EQ (attr
, QCfamily
))
3446 if (!UNSPECIFIEDP (value
))
3448 CHECK_STRING (value
, 3);
3449 if (XSTRING (value
)->size
== 0)
3450 signal_error ("Invalid face family", value
);
3452 old_value
= LFACE_FAMILY (lface
);
3453 LFACE_FAMILY (lface
) = value
;
3454 font_related_attr_p
= 1;
3456 else if (EQ (attr
, QCheight
))
3458 if (!UNSPECIFIEDP (value
))
3460 CHECK_NUMBER (value
, 3);
3461 if (XINT (value
) <= 0)
3462 signal_error ("Invalid face height", value
);
3464 old_value
= LFACE_HEIGHT (lface
);
3465 LFACE_HEIGHT (lface
) = value
;
3466 font_related_attr_p
= 1;
3468 else if (EQ (attr
, QCweight
))
3470 if (!UNSPECIFIEDP (value
))
3472 CHECK_SYMBOL (value
, 3);
3473 if (face_numeric_weight (value
) < 0)
3474 signal_error ("Invalid face weight", value
);
3476 old_value
= LFACE_WEIGHT (lface
);
3477 LFACE_WEIGHT (lface
) = value
;
3478 font_related_attr_p
= 1;
3480 else if (EQ (attr
, QCslant
))
3482 if (!UNSPECIFIEDP (value
))
3484 CHECK_SYMBOL (value
, 3);
3485 if (face_numeric_slant (value
) < 0)
3486 signal_error ("Invalid face slant", value
);
3488 old_value
= LFACE_SLANT (lface
);
3489 LFACE_SLANT (lface
) = value
;
3490 font_related_attr_p
= 1;
3492 else if (EQ (attr
, QCunderline
))
3494 if (!UNSPECIFIEDP (value
))
3495 if ((SYMBOLP (value
)
3497 && !EQ (value
, Qnil
))
3498 /* Underline color. */
3500 && XSTRING (value
)->size
== 0))
3501 signal_error ("Invalid face underline", value
);
3503 old_value
= LFACE_UNDERLINE (lface
);
3504 LFACE_UNDERLINE (lface
) = value
;
3506 else if (EQ (attr
, QCoverline
))
3508 if (!UNSPECIFIEDP (value
))
3509 if ((SYMBOLP (value
)
3511 && !EQ (value
, Qnil
))
3512 /* Overline color. */
3514 && XSTRING (value
)->size
== 0))
3515 signal_error ("Invalid face overline", value
);
3517 old_value
= LFACE_OVERLINE (lface
);
3518 LFACE_OVERLINE (lface
) = value
;
3520 else if (EQ (attr
, QCstrike_through
))
3522 if (!UNSPECIFIEDP (value
))
3523 if ((SYMBOLP (value
)
3525 && !EQ (value
, Qnil
))
3526 /* Strike-through color. */
3528 && XSTRING (value
)->size
== 0))
3529 signal_error ("Invalid face strike-through", value
);
3531 old_value
= LFACE_STRIKE_THROUGH (lface
);
3532 LFACE_STRIKE_THROUGH (lface
) = value
;
3534 else if (EQ (attr
, QCbox
))
3538 /* Allow t meaning a simple box of width 1 in foreground color
3541 value
= make_number (1);
3543 if (UNSPECIFIEDP (value
))
3545 else if (NILP (value
))
3547 else if (INTEGERP (value
))
3548 valid_p
= XINT (value
) > 0;
3549 else if (STRINGP (value
))
3550 valid_p
= XSTRING (value
)->size
> 0;
3551 else if (CONSP (value
))
3567 if (EQ (k
, QCline_width
))
3569 if (!INTEGERP (v
) || XINT (v
) <= 0)
3572 else if (EQ (k
, QCcolor
))
3574 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3577 else if (EQ (k
, QCstyle
))
3579 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3586 valid_p
= NILP (tem
);
3592 signal_error ("Invalid face box", value
);
3594 old_value
= LFACE_BOX (lface
);
3595 LFACE_BOX (lface
) = value
;
3597 else if (EQ (attr
, QCinverse_video
)
3598 || EQ (attr
, QCreverse_video
))
3600 if (!UNSPECIFIEDP (value
))
3602 CHECK_SYMBOL (value
, 3);
3603 if (!EQ (value
, Qt
) && !NILP (value
))
3604 signal_error ("Invalid inverse-video face attribute value", value
);
3606 old_value
= LFACE_INVERSE (lface
);
3607 LFACE_INVERSE (lface
) = value
;
3609 else if (EQ (attr
, QCforeground
))
3611 if (!UNSPECIFIEDP (value
))
3613 /* Don't check for valid color names here because it depends
3614 on the frame (display) whether the color will be valid
3615 when the face is realized. */
3616 CHECK_STRING (value
, 3);
3617 if (XSTRING (value
)->size
== 0)
3618 signal_error ("Empty foreground color value", value
);
3620 old_value
= LFACE_FOREGROUND (lface
);
3621 LFACE_FOREGROUND (lface
) = value
;
3623 else if (EQ (attr
, QCbackground
))
3625 if (!UNSPECIFIEDP (value
))
3627 /* Don't check for valid color names here because it depends
3628 on the frame (display) whether the color will be valid
3629 when the face is realized. */
3630 CHECK_STRING (value
, 3);
3631 if (XSTRING (value
)->size
== 0)
3632 signal_error ("Empty background color value", value
);
3634 old_value
= LFACE_BACKGROUND (lface
);
3635 LFACE_BACKGROUND (lface
) = value
;
3637 else if (EQ (attr
, QCstipple
))
3639 #ifdef HAVE_X_WINDOWS
3640 if (!UNSPECIFIEDP (value
)
3642 && NILP (Fbitmap_spec_p (value
)))
3643 signal_error ("Invalid stipple attribute", value
);
3644 old_value
= LFACE_STIPPLE (lface
);
3645 LFACE_STIPPLE (lface
) = value
;
3646 #endif /* HAVE_X_WINDOWS */
3648 else if (EQ (attr
, QCwidth
))
3650 if (!UNSPECIFIEDP (value
))
3652 CHECK_SYMBOL (value
, 3);
3653 if (face_numeric_swidth (value
) < 0)
3654 signal_error ("Invalid face width", value
);
3656 old_value
= LFACE_SWIDTH (lface
);
3657 LFACE_SWIDTH (lface
) = value
;
3658 font_related_attr_p
= 1;
3660 else if (EQ (attr
, QCfont
))
3662 #ifdef HAVE_WINDOW_SYSTEM
3663 /* Set font-related attributes of the Lisp face from an
3668 CHECK_STRING (value
, 3);
3670 f
= SELECTED_FRAME ();
3672 f
= check_x_frame (frame
);
3674 /* VALUE may be a fontset name or an alias of fontset. In such
3675 a case, use the base fontset name. */
3676 tmp
= Fquery_fontset (value
, Qnil
);
3680 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3681 signal_error ("Invalid font or fontset name", value
);
3684 #endif /* HAVE_WINDOW_SYSTEM */
3686 else if (EQ (attr
, QCbold
))
3688 old_value
= LFACE_WEIGHT (lface
);
3689 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3690 font_related_attr_p
= 1;
3692 else if (EQ (attr
, QCitalic
))
3694 old_value
= LFACE_SLANT (lface
);
3695 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3696 font_related_attr_p
= 1;
3699 signal_error ("Invalid face attribute name", attr
);
3701 if (font_related_attr_p
3702 && !UNSPECIFIEDP (value
))
3703 /* If a font-related attribute other than QCfont is specified, the
3704 original `font' attribute nor that of default face is useless
3705 to determine a new font. Thus, we set it to nil so that font
3706 selection mechanism doesn't use it. */
3707 LFACE_FONT (lface
) = Qnil
;
3709 /* Changing a named face means that all realized faces depending on
3710 that face are invalid. Since we cannot tell which realized faces
3711 depend on the face, make sure they are all removed. This is done
3712 by incrementing face_change_count. The next call to
3713 init_iterator will then free realized faces. */
3715 && (EQ (attr
, QCfont
)
3716 || NILP (Fequal (old_value
, value
))))
3718 ++face_change_count
;
3719 ++windows_or_buffers_changed
;
3722 #ifdef HAVE_WINDOW_SYSTEM
3725 && !UNSPECIFIEDP (value
)
3726 && NILP (Fequal (old_value
, value
)))
3732 if (EQ (face
, Qdefault
))
3734 /* Changed font-related attributes of the `default' face are
3735 reflected in changed `font' frame parameters. */
3736 if ((font_related_attr_p
|| font_attr_p
)
3737 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3738 set_font_frame_param (frame
, lface
);
3739 else if (EQ (attr
, QCforeground
))
3740 param
= Qforeground_color
;
3741 else if (EQ (attr
, QCbackground
))
3742 param
= Qbackground_color
;
3745 else if (EQ (face
, Qscroll_bar
))
3747 /* Changing the colors of `scroll-bar' sets frame parameters
3748 `scroll-bar-foreground' and `scroll-bar-background'. */
3749 if (EQ (attr
, QCforeground
))
3750 param
= Qscroll_bar_foreground
;
3751 else if (EQ (attr
, QCbackground
))
3752 param
= Qscroll_bar_background
;
3755 else if (EQ (face
, Qborder
))
3757 /* Changing background color of `border' sets frame parameter
3759 if (EQ (attr
, QCbackground
))
3760 param
= Qborder_color
;
3762 else if (EQ (face
, Qcursor
))
3764 /* Changing background color of `cursor' sets frame parameter
3766 if (EQ (attr
, QCbackground
))
3767 param
= Qcursor_color
;
3769 else if (EQ (face
, Qmouse
))
3771 /* Changing background color of `mouse' sets frame parameter
3773 if (EQ (attr
, QCbackground
))
3774 param
= Qmouse_color
;
3778 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3781 #endif /* HAVE_WINDOW_SYSTEM */
3787 #ifdef HAVE_WINDOW_SYSTEM
3789 /* Set the `font' frame parameter of FRAME determined from `default'
3790 face attributes LFACE. If a face or fontset name is explicitely
3791 specfied in LFACE, use it as is. Otherwise, determine a font name
3792 from the other font-related atrributes of LFACE. In that case, if
3793 there's no matching font, signals an error. */
3796 set_font_frame_param (frame
, lface
)
3797 Lisp_Object frame
, lface
;
3799 struct frame
*f
= XFRAME (frame
);
3800 Lisp_Object font_name
;
3803 if (STRINGP (LFACE_FONT (lface
)))
3804 font_name
= LFACE_FONT (lface
);
3807 /* Choose a font name that reflects LFACE's attributes and has
3808 the registry and encoding pattern specified in the default
3809 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
3810 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
3812 error ("No font matches the specified attribute");
3813 font_name
= build_string (font
);
3816 store_frame_param (f
, Qfont
, font_name
);
3820 /* Update the corresponding face when frame parameter PARAM on frame F
3821 has been assigned the value NEW_VALUE. */
3824 update_face_from_frame_parameter (f
, param
, new_value
)
3826 Lisp_Object param
, new_value
;
3830 /* If there are no faces yet, give up. This is the case when called
3831 from Fx_create_frame, and we do the necessary things later in
3832 face-set-after-frame-defaults. */
3833 if (NILP (f
->face_alist
))
3836 if (EQ (param
, Qforeground_color
))
3838 lface
= lface_from_face_name (f
, Qdefault
, 1);
3839 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3840 ? new_value
: Qunspecified
);
3841 realize_basic_faces (f
);
3843 else if (EQ (param
, Qbackground_color
))
3847 /* Changing the background color might change the background
3848 mode, so that we have to load new defface specs. Call
3849 frame-update-face-colors to do that. */
3850 XSETFRAME (frame
, f
);
3851 call1 (Qframe_update_face_colors
, frame
);
3853 lface
= lface_from_face_name (f
, Qdefault
, 1);
3854 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3855 ? new_value
: Qunspecified
);
3856 realize_basic_faces (f
);
3858 if (EQ (param
, Qborder_color
))
3860 lface
= lface_from_face_name (f
, Qborder
, 1);
3861 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3862 ? new_value
: Qunspecified
);
3864 else if (EQ (param
, Qcursor_color
))
3866 lface
= lface_from_face_name (f
, Qcursor
, 1);
3867 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3868 ? new_value
: Qunspecified
);
3870 else if (EQ (param
, Qmouse_color
))
3872 lface
= lface_from_face_name (f
, Qmouse
, 1);
3873 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3874 ? new_value
: Qunspecified
);
3879 /* Get the value of X resource RESOURCE, class CLASS for the display
3880 of frame FRAME. This is here because ordinary `x-get-resource'
3881 doesn't take a frame argument. */
3883 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3884 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3885 (resource
, class, frame
)
3886 Lisp_Object resource
, class, frame
;
3888 Lisp_Object value
= Qnil
;
3890 CHECK_STRING (resource
, 0);
3891 CHECK_STRING (class, 1);
3892 CHECK_LIVE_FRAME (frame
, 2);
3894 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3895 resource
, class, Qnil
, Qnil
);
3902 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3903 If VALUE is "on" or "true", return t. If VALUE is "off" or
3904 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3905 error; if SIGNAL_P is zero, return 0. */
3908 face_boolean_x_resource_value (value
, signal_p
)
3912 Lisp_Object result
= make_number (0);
3914 xassert (STRINGP (value
));
3916 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3917 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3919 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3920 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3922 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3923 result
= Qunspecified
;
3925 signal_error ("Invalid face attribute value from X resource", value
);
3931 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3932 Finternal_set_lisp_face_attribute_from_resource
,
3933 Sinternal_set_lisp_face_attribute_from_resource
,
3935 (face
, attr
, value
, frame
)
3936 Lisp_Object face
, attr
, value
, frame
;
3938 CHECK_SYMBOL (face
, 0);
3939 CHECK_SYMBOL (attr
, 1);
3940 CHECK_STRING (value
, 2);
3942 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3943 value
= Qunspecified
;
3944 else if (EQ (attr
, QCheight
))
3946 value
= Fstring_to_number (value
, make_number (10));
3947 if (XINT (value
) <= 0)
3948 signal_error ("Invalid face height from X resource", value
);
3950 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3951 value
= face_boolean_x_resource_value (value
, 1);
3952 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3953 value
= intern (XSTRING (value
)->data
);
3954 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3955 value
= face_boolean_x_resource_value (value
, 1);
3956 else if (EQ (attr
, QCunderline
)
3957 || EQ (attr
, QCoverline
)
3958 || EQ (attr
, QCstrike_through
)
3959 || EQ (attr
, QCbox
))
3961 Lisp_Object boolean_value
;
3963 /* If the result of face_boolean_x_resource_value is t or nil,
3964 VALUE does NOT specify a color. */
3965 boolean_value
= face_boolean_x_resource_value (value
, 0);
3966 if (SYMBOLP (boolean_value
))
3967 value
= boolean_value
;
3970 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3973 #endif /* HAVE_WINDOW_SYSTEM */
3976 #ifdef HAVE_X_WINDOWS
3977 /***********************************************************************
3979 ***********************************************************************/
3981 #ifdef USE_X_TOOLKIT
3983 #include "../lwlib/lwlib-utils.h"
3985 /* Structure used to pass X resources to functions called via
3986 XtApplyToWidgets. */
3997 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3998 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4001 /* Set widget W's X resources from P which points to an x_resources
4002 structure. If W is a cascade button, apply resources to W's
4006 xm_apply_resources (w
, p
)
4011 struct x_resources
*res
= (struct x_resources
*) p
;
4013 XtSetValues (w
, res
->av
, res
->ac
);
4014 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
4017 XtSetValues (submenu
, res
->av
, res
->ac
);
4018 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
4023 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
4024 This is the LessTif/Motif version. As of LessTif 0.88 it has the
4027 1. Setting the XmNfontList resource leads to an infinite loop
4028 somewhere in LessTif. */
4031 xm_set_menu_resources_from_menu_face (f
, widget
)
4041 lface
= lface_from_face_name (f
, Qmenu
, 1);
4042 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4044 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4046 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4050 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4052 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4056 /* If any font-related attribute of `menu' is set, set the font. */
4058 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4059 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4060 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4061 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4062 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4064 #if 0 /* Setting the font leads to an infinite loop somewhere
4065 in LessTif during geometry computation. */
4067 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4068 fl
= XmFontListAppendEntry (NULL
, fe
);
4069 XtSetArg (av
[ac
], XmNfontList
, fl
);
4074 xassert (ac
<= sizeof av
/ sizeof *av
);
4078 struct x_resources res
;
4080 XtSetValues (widget
, av
, ac
);
4081 res
.av
= av
, res
.ac
= ac
;
4082 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4084 XmFontListFree (fl
);
4089 #endif /* USE_MOTIF */
4093 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4094 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4097 /* Set widget W's resources from P which points to an x_resources
4101 xl_apply_resources (widget
, p
)
4105 struct x_resources
*res
= (struct x_resources
*) p
;
4106 XtSetValues (widget
, res
->av
, res
->ac
);
4110 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4111 This is the Lucid version. */
4114 xl_set_menu_resources_from_menu_face (f
, widget
)
4123 lface
= lface_from_face_name (f
, Qmenu
, 1);
4124 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4126 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4128 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4132 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4134 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4139 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4140 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4141 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4142 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4143 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4145 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4151 struct x_resources res
;
4153 XtSetValues (widget
, av
, ac
);
4155 /* We must do children here in case we're handling a pop-up menu
4156 in which case WIDGET is a popup shell. XtApplyToWidgets
4157 is a function from lwlib. */
4158 res
.av
= av
, res
.ac
= ac
;
4159 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4163 #endif /* USE_LUCID */
4166 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4169 x_set_menu_resources_from_menu_face (f
, widget
)
4173 /* Realized faces may have been removed on frame F, e.g. because of
4174 face attribute changes. Recompute them, if necessary, since we
4175 will need the `menu' face. */
4176 if (f
->face_cache
->used
== 0)
4177 recompute_basic_faces (f
);
4180 xl_set_menu_resources_from_menu_face (f
, widget
);
4183 xm_set_menu_resources_from_menu_face (f
, widget
);
4187 #endif /* USE_X_TOOLKIT */
4189 #endif /* HAVE_X_WINDOWS */
4193 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4194 Sinternal_get_lisp_face_attribute
,
4196 "Return face attribute KEYWORD of face SYMBOL.\n\
4197 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4198 face attribute name, signal an error.\n\
4199 If the optional argument FRAME is given, report on face FACE in that\n\
4200 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4201 frames). If FRAME is omitted or nil, use the selected frame.")
4202 (symbol
, keyword
, frame
)
4203 Lisp_Object symbol
, keyword
, frame
;
4205 Lisp_Object lface
, value
= Qnil
;
4207 CHECK_SYMBOL (symbol
, 0);
4208 CHECK_SYMBOL (keyword
, 1);
4211 lface
= lface_from_face_name (NULL
, symbol
, 1);
4215 frame
= selected_frame
;
4216 CHECK_LIVE_FRAME (frame
, 2);
4217 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4220 if (EQ (keyword
, QCfamily
))
4221 value
= LFACE_FAMILY (lface
);
4222 else if (EQ (keyword
, QCheight
))
4223 value
= LFACE_HEIGHT (lface
);
4224 else if (EQ (keyword
, QCweight
))
4225 value
= LFACE_WEIGHT (lface
);
4226 else if (EQ (keyword
, QCslant
))
4227 value
= LFACE_SLANT (lface
);
4228 else if (EQ (keyword
, QCunderline
))
4229 value
= LFACE_UNDERLINE (lface
);
4230 else if (EQ (keyword
, QCoverline
))
4231 value
= LFACE_OVERLINE (lface
);
4232 else if (EQ (keyword
, QCstrike_through
))
4233 value
= LFACE_STRIKE_THROUGH (lface
);
4234 else if (EQ (keyword
, QCbox
))
4235 value
= LFACE_BOX (lface
);
4236 else if (EQ (keyword
, QCinverse_video
)
4237 || EQ (keyword
, QCreverse_video
))
4238 value
= LFACE_INVERSE (lface
);
4239 else if (EQ (keyword
, QCforeground
))
4240 value
= LFACE_FOREGROUND (lface
);
4241 else if (EQ (keyword
, QCbackground
))
4242 value
= LFACE_BACKGROUND (lface
);
4243 else if (EQ (keyword
, QCstipple
))
4244 value
= LFACE_STIPPLE (lface
);
4245 else if (EQ (keyword
, QCwidth
))
4246 value
= LFACE_SWIDTH (lface
);
4247 else if (EQ (keyword
, QCfont
))
4248 value
= LFACE_FONT (lface
);
4250 signal_error ("Invalid face attribute name", keyword
);
4256 DEFUN ("internal-lisp-face-attribute-values",
4257 Finternal_lisp_face_attribute_values
,
4258 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4259 "Return a list of valid discrete values for face attribute ATTR.\n\
4260 Value is nil if ATTR doesn't have a discrete set of valid values.")
4264 Lisp_Object result
= Qnil
;
4266 CHECK_SYMBOL (attr
, 0);
4268 if (EQ (attr
, QCweight
)
4269 || EQ (attr
, QCslant
)
4270 || EQ (attr
, QCwidth
))
4272 /* Extract permissible symbols from tables. */
4273 struct table_entry
*table
;
4276 if (EQ (attr
, QCweight
))
4277 table
= weight_table
, dim
= DIM (weight_table
);
4278 else if (EQ (attr
, QCslant
))
4279 table
= slant_table
, dim
= DIM (slant_table
);
4281 table
= swidth_table
, dim
= DIM (swidth_table
);
4283 for (i
= 0; i
< dim
; ++i
)
4285 Lisp_Object symbol
= *table
[i
].symbol
;
4286 Lisp_Object tail
= result
;
4289 && !EQ (XCAR (tail
), symbol
))
4293 result
= Fcons (symbol
, result
);
4296 else if (EQ (attr
, QCunderline
))
4297 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4298 else if (EQ (attr
, QCoverline
))
4299 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4300 else if (EQ (attr
, QCstrike_through
))
4301 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4302 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4303 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4309 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4310 Sinternal_merge_in_global_face
, 2, 2, 0,
4311 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4313 Lisp_Object face
, frame
;
4315 Lisp_Object global_lface
, local_lface
;
4316 CHECK_LIVE_FRAME (frame
, 1);
4317 global_lface
= lface_from_face_name (NULL
, face
, 1);
4318 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4319 if (NILP (local_lface
))
4320 local_lface
= Finternal_make_lisp_face (face
, frame
);
4321 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4322 XVECTOR (local_lface
)->contents
);
4327 /* The following function is implemented for compatibility with 20.2.
4328 The function is used in x-resolve-fonts when it is asked to
4329 return fonts with the same size as the font of a face. This is
4330 done in fontset.el. */
4332 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4333 "Return the font name of face FACE, or nil if it is unspecified.\n\
4334 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4335 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4336 The font default for a face is either nil, or a list\n\
4337 of the form (bold), (italic) or (bold italic).\n\
4338 If FRAME is omitted or nil, use the selected frame.")
4340 Lisp_Object face
, frame
;
4344 Lisp_Object result
= Qnil
;
4345 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4347 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4348 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4349 result
= Fcons (Qbold
, result
);
4351 if (!NILP (LFACE_SLANT (lface
))
4352 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4353 result
= Fcons (Qitalic
, result
);
4359 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4360 int face_id
= lookup_named_face (f
, face
, 0);
4361 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4362 return build_string (face
->font_name
);
4367 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4368 all attributes are `equal'. Tries to be fast because this function
4369 is called quite often. */
4372 lface_equal_p (v1
, v2
)
4373 Lisp_Object
*v1
, *v2
;
4377 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4379 Lisp_Object a
= v1
[i
];
4380 Lisp_Object b
= v2
[i
];
4382 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4383 and the other is specified. */
4384 equal_p
= XTYPE (a
) == XTYPE (b
);
4393 equal_p
= ((STRING_BYTES (XSTRING (a
))
4394 == STRING_BYTES (XSTRING (b
)))
4395 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4396 STRING_BYTES (XSTRING (a
))) == 0);
4405 equal_p
= !NILP (Fequal (a
, b
));
4415 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4416 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4417 "True if FACE1 and FACE2 are equal.\n\
4418 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4419 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4420 If FRAME is omitted or nil, use the selected frame.")
4421 (face1
, face2
, frame
)
4422 Lisp_Object face1
, face2
, frame
;
4426 Lisp_Object lface1
, lface2
;
4431 /* Don't use check_x_frame here because this function is called
4432 before X frames exist. At that time, if FRAME is nil,
4433 selected_frame will be used which is the frame dumped with
4434 Emacs. That frame is not an X frame. */
4435 f
= frame_or_selected_frame (frame
, 2);
4437 lface1
= lface_from_face_name (NULL
, face1
, 1);
4438 lface2
= lface_from_face_name (NULL
, face2
, 1);
4439 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4440 XVECTOR (lface2
)->contents
);
4441 return equal_p
? Qt
: Qnil
;
4445 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4446 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4447 "True if FACE has no attribute specified.\n\
4448 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4449 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4450 If FRAME is omitted or nil, use the selected frame.")
4452 Lisp_Object face
, frame
;
4459 frame
= selected_frame
;
4460 CHECK_LIVE_FRAME (frame
, 0);
4464 lface
= lface_from_face_name (NULL
, face
, 1);
4466 lface
= lface_from_face_name (f
, face
, 1);
4468 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4469 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4472 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4476 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4478 "Return an alist of frame-local faces defined on FRAME.\n\
4479 For internal use only.")
4483 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4484 return f
->face_alist
;
4488 /* Return a hash code for Lisp string STRING with case ignored. Used
4489 below in computing a hash value for a Lisp face. */
4491 static INLINE
unsigned
4492 hash_string_case_insensitive (string
)
4497 xassert (STRINGP (string
));
4498 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4499 hash
= (hash
<< 1) ^ tolower (*s
);
4504 /* Return a hash code for face attribute vector V. */
4506 static INLINE
unsigned
4510 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4511 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4512 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4513 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4514 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4515 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4516 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4520 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4521 considering charsets/registries). They do if they specify the same
4522 family, point size, weight, width, slant, and fontset. Both LFACE1
4523 and LFACE2 must be fully-specified. */
4526 lface_same_font_attributes_p (lface1
, lface2
)
4527 Lisp_Object
*lface1
, *lface2
;
4529 xassert (lface_fully_specified_p (lface1
)
4530 && lface_fully_specified_p (lface2
));
4531 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4532 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4533 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4534 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4535 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4536 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4537 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4538 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4539 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4540 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4541 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4542 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4547 /***********************************************************************
4549 ***********************************************************************/
4551 /* Allocate and return a new realized face for Lisp face attribute
4554 static struct face
*
4555 make_realized_face (attr
)
4558 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4559 bzero (face
, sizeof *face
);
4560 face
->ascii_face
= face
;
4561 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4566 /* Free realized face FACE, including its X resources. FACE may
4570 free_realized_face (f
, face
)
4576 #ifdef HAVE_WINDOW_SYSTEM
4577 if (FRAME_WINDOW_P (f
))
4579 /* Free fontset of FACE if it is ASCII face. */
4580 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4581 free_face_fontset (f
, face
);
4584 x_free_gc (f
, face
->gc
);
4588 free_face_colors (f
, face
);
4589 x_destroy_bitmap (f
, face
->stipple
);
4591 #endif /* HAVE_WINDOW_SYSTEM */
4598 /* Prepare face FACE for subsequent display on frame F. This
4599 allocated GCs if they haven't been allocated yet or have been freed
4600 by clearing the face cache. */
4603 prepare_face_for_display (f
, face
)
4607 #ifdef HAVE_WINDOW_SYSTEM
4608 xassert (FRAME_WINDOW_P (f
));
4613 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4615 xgcv
.foreground
= face
->foreground
;
4616 xgcv
.background
= face
->background
;
4617 #ifdef HAVE_X_WINDOWS
4618 xgcv
.graphics_exposures
= False
;
4620 /* The font of FACE may be null if we couldn't load it. */
4623 #ifdef HAVE_X_WINDOWS
4624 xgcv
.font
= face
->font
->fid
;
4627 xgcv
.font
= face
->font
;
4633 #ifdef HAVE_X_WINDOWS
4636 xgcv
.fill_style
= FillOpaqueStippled
;
4637 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4638 mask
|= GCFillStyle
| GCStipple
;
4641 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4644 #endif /* HAVE_WINDOW_SYSTEM */
4648 /***********************************************************************
4650 ***********************************************************************/
4652 /* Return a new face cache for frame F. */
4654 static struct face_cache
*
4658 struct face_cache
*c
;
4661 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4662 bzero (c
, sizeof *c
);
4663 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4664 c
->buckets
= (struct face
**) xmalloc (size
);
4665 bzero (c
->buckets
, size
);
4667 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4673 /* Clear out all graphics contexts for all realized faces, except for
4674 the basic faces. This should be done from time to time just to avoid
4675 keeping too many graphics contexts that are no longer needed. */
4679 struct face_cache
*c
;
4681 if (c
&& FRAME_WINDOW_P (c
->f
))
4683 #ifdef HAVE_WINDOW_SYSTEM
4685 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4687 struct face
*face
= c
->faces_by_id
[i
];
4688 if (face
&& face
->gc
)
4690 x_free_gc (c
->f
, face
->gc
);
4694 #endif /* HAVE_WINDOW_SYSTEM */
4699 /* Free all realized faces in face cache C, including basic faces. C
4700 may be null. If faces are freed, make sure the frame's current
4701 matrix is marked invalid, so that a display caused by an expose
4702 event doesn't try to use faces we destroyed. */
4705 free_realized_faces (c
)
4706 struct face_cache
*c
;
4711 struct frame
*f
= c
->f
;
4713 /* We must block input here because we can't process X events
4714 safely while only some faces are freed, or when the frame's
4715 current matrix still references freed faces. */
4718 for (i
= 0; i
< c
->used
; ++i
)
4720 free_realized_face (f
, c
->faces_by_id
[i
]);
4721 c
->faces_by_id
[i
] = NULL
;
4725 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4726 bzero (c
->buckets
, size
);
4728 /* Must do a thorough redisplay the next time. Mark current
4729 matrices as invalid because they will reference faces freed
4730 above. This function is also called when a frame is
4731 destroyed. In this case, the root window of F is nil. */
4732 if (WINDOWP (f
->root_window
))
4734 clear_current_matrices (f
);
4735 ++windows_or_buffers_changed
;
4743 /* Free all faces realized for multibyte characters on frame F that
4747 free_realized_multibyte_face (f
, fontset
)
4751 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4755 /* We must block input here because we can't process X events safely
4756 while only some faces are freed, or when the frame's current
4757 matrix still references freed faces. */
4760 for (i
= 0; i
< cache
->used
; i
++)
4762 face
= cache
->faces_by_id
[i
];
4764 && face
!= face
->ascii_face
4765 && face
->fontset
== fontset
)
4767 uncache_face (cache
, face
);
4768 free_realized_face (f
, face
);
4772 /* Must do a thorough redisplay the next time. Mark current
4773 matrices as invalid because they will reference faces freed
4774 above. This function is also called when a frame is destroyed.
4775 In this case, the root window of F is nil. */
4776 if (WINDOWP (f
->root_window
))
4778 clear_current_matrices (f
);
4779 ++windows_or_buffers_changed
;
4786 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4787 This is done after attributes of a named face have been changed,
4788 because we can't tell which realized faces depend on that face. */
4791 free_all_realized_faces (frame
)
4797 FOR_EACH_FRAME (rest
, frame
)
4798 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4801 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4805 /* Free face cache C and faces in it, including their X resources. */
4809 struct face_cache
*c
;
4813 free_realized_faces (c
);
4815 xfree (c
->faces_by_id
);
4821 /* Cache realized face FACE in face cache C. HASH is the hash value
4822 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4823 collision list of the face hash table of C. This is done because
4824 otherwise lookup_face would find FACE for every character, even if
4825 faces with the same attributes but for specific characters exist. */
4828 cache_face (c
, face
, hash
)
4829 struct face_cache
*c
;
4833 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4837 if (face
->fontset
>= 0)
4839 struct face
*last
= c
->buckets
[i
];
4850 c
->buckets
[i
] = face
;
4851 face
->prev
= face
->next
= NULL
;
4857 face
->next
= c
->buckets
[i
];
4859 face
->next
->prev
= face
;
4860 c
->buckets
[i
] = face
;
4863 /* Find a free slot in C->faces_by_id and use the index of the free
4864 slot as FACE->id. */
4865 for (i
= 0; i
< c
->used
; ++i
)
4866 if (c
->faces_by_id
[i
] == NULL
)
4870 /* Maybe enlarge C->faces_by_id. */
4871 if (i
== c
->used
&& c
->used
== c
->size
)
4873 int new_size
= 2 * c
->size
;
4874 int sz
= new_size
* sizeof *c
->faces_by_id
;
4875 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4880 /* Check that FACE got a unique id. */
4885 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4886 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4892 #endif /* GLYPH_DEBUG */
4894 c
->faces_by_id
[i
] = face
;
4900 /* Remove face FACE from cache C. */
4903 uncache_face (c
, face
)
4904 struct face_cache
*c
;
4907 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4910 face
->prev
->next
= face
->next
;
4912 c
->buckets
[i
] = face
->next
;
4915 face
->next
->prev
= face
->prev
;
4917 c
->faces_by_id
[face
->id
] = NULL
;
4918 if (face
->id
== c
->used
)
4923 /* Look up a realized face with face attributes ATTR in the face cache
4924 of frame F. The face will be used to display character C. Value
4925 is the ID of the face found. If no suitable face is found, realize
4926 a new one. In that case, if C is a multibyte character, BASE_FACE
4927 is a face that has the same attributes. */
4930 lookup_face (f
, attr
, c
, base_face
)
4934 struct face
*base_face
;
4936 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4941 xassert (cache
!= NULL
);
4942 check_lface_attrs (attr
);
4944 /* Look up ATTR in the face cache. */
4945 hash
= lface_hash (attr
);
4946 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4948 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4949 if (face
->hash
== hash
4950 && (!FRAME_WINDOW_P (f
)
4951 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
4952 && lface_equal_p (face
->lface
, attr
))
4955 /* If not found, realize a new face. */
4957 face
= realize_face (cache
, attr
, c
, base_face
, -1);
4960 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4962 /* When this function is called from face_for_char (in this case, C is
4963 a multibyte character), a fontset of a face returned by
4964 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
4965 C) is not sutisfied. The fontset is set for this face by
4966 face_for_char later. */
4968 if (FRAME_WINDOW_P (f
))
4969 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
4971 #endif /* GLYPH_DEBUG */
4977 /* Return the face id of the realized face for named face SYMBOL on
4978 frame F suitable for displaying character C. */
4981 lookup_named_face (f
, symbol
, c
)
4986 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4987 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4988 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4990 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4991 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4992 merge_face_vectors (symbol_attrs
, attrs
);
4993 return lookup_face (f
, attrs
, c
, NULL
);
4997 /* Return the ID of the realized ASCII face of Lisp face with ID
4998 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5001 ascii_face_of_lisp_face (f
, lface_id
)
5007 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5009 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5010 face_id
= lookup_named_face (f
, face_name
, 0);
5019 /* Return a face for charset ASCII that is like the face with id
5020 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5021 STEPS < 0 means larger. Value is the id of the face. */
5024 smaller_face (f
, face_id
, steps
)
5028 #ifdef HAVE_WINDOW_SYSTEM
5030 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5031 int pt
, last_pt
, last_height
;
5034 struct face
*new_face
;
5036 /* If not called for an X frame, just return the original face. */
5037 if (FRAME_TERMCAP_P (f
))
5040 /* Try in increments of 1/2 pt. */
5041 delta
= steps
< 0 ? 5 : -5;
5042 steps
= abs (steps
);
5044 face
= FACE_FROM_ID (f
, face_id
);
5045 bcopy (face
->lface
, attrs
, sizeof attrs
);
5046 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5047 new_face_id
= face_id
;
5048 last_height
= FONT_HEIGHT (face
->font
);
5052 /* Give up if we cannot find a font within 10pt. */
5053 && abs (last_pt
- pt
) < 100)
5055 /* Look up a face for a slightly smaller/larger font. */
5057 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5058 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5059 new_face
= FACE_FROM_ID (f
, new_face_id
);
5061 /* If height changes, count that as one step. */
5062 if (FONT_HEIGHT (new_face
->font
) != last_height
)
5065 last_height
= FONT_HEIGHT (new_face
->font
);
5072 #else /* not HAVE_WINDOW_SYSTEM */
5076 #endif /* not HAVE_WINDOW_SYSTEM */
5080 /* Return a face for charset ASCII that is like the face with id
5081 FACE_ID on frame F, but has height HEIGHT. */
5084 face_with_height (f
, face_id
, height
)
5089 #ifdef HAVE_WINDOW_SYSTEM
5091 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5093 if (FRAME_TERMCAP_P (f
)
5097 face
= FACE_FROM_ID (f
, face_id
);
5098 bcopy (face
->lface
, attrs
, sizeof attrs
);
5099 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5100 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5101 #endif /* HAVE_WINDOW_SYSTEM */
5106 /* Return the face id of the realized face for named face SYMBOL on
5107 frame F suitable for displaying character C, and use attributes of
5108 the face FACE_ID for attributes that aren't completely specified by
5109 SYMBOL. This is like lookup_named_face, except that the default
5110 attributes come from FACE_ID, not from the default face. FACE_ID
5111 is assumed to be already realized. */
5114 lookup_derived_face (f
, symbol
, c
, face_id
)
5120 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5121 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5122 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5127 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5128 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5129 merge_face_vectors (symbol_attrs
, attrs
);
5130 return lookup_face (f
, attrs
, c
, default_face
);
5135 /***********************************************************************
5137 ***********************************************************************/
5139 DEFUN ("internal-set-font-selection-order",
5140 Finternal_set_font_selection_order
,
5141 Sinternal_set_font_selection_order
, 1, 1, 0,
5142 "Set font selection order for face font selection to ORDER.\n\
5143 ORDER must be a list of length 4 containing the symbols `:width',\n\
5144 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5145 first in ORDER are matched first, e.g. if `:height' appears before\n\
5146 `:weight' in ORDER, font selection first tries to find a font with\n\
5147 a suitable height, and then tries to match the font weight.\n\
5156 CHECK_LIST (order
, 0);
5157 bzero (indices
, sizeof indices
);
5161 CONSP (list
) && i
< DIM (indices
);
5162 list
= XCDR (list
), ++i
)
5164 Lisp_Object attr
= XCAR (list
);
5167 if (EQ (attr
, QCwidth
))
5169 else if (EQ (attr
, QCheight
))
5170 xlfd
= XLFD_POINT_SIZE
;
5171 else if (EQ (attr
, QCweight
))
5173 else if (EQ (attr
, QCslant
))
5178 if (indices
[i
] != 0)
5184 || i
!= DIM (indices
)
5189 signal_error ("Invalid font sort order", order
);
5191 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5193 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5194 free_all_realized_faces (Qnil
);
5201 DEFUN ("internal-set-alternative-font-family-alist",
5202 Finternal_set_alternative_font_family_alist
,
5203 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5204 "Define alternative font families to try in face font selection.\n\
5205 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5206 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5207 be found. Value is ALIST.")
5211 CHECK_LIST (alist
, 0);
5212 Vface_alternative_font_family_alist
= alist
;
5213 free_all_realized_faces (Qnil
);
5218 #ifdef HAVE_WINDOW_SYSTEM
5220 /* Value is non-zero if FONT is the name of a scalable font. The
5221 X11R6 XLFD spec says that point size, pixel size, and average width
5222 are zero for scalable fonts. Intlfonts contain at least one
5223 scalable font ("*-muleindian-1") for which this isn't true, so we
5224 just test average width. */
5227 font_scalable_p (font
)
5228 struct font_name
*font
;
5230 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5231 return (*s
== '0' && *(s
+ 1) == '\0')
5233 /* Windows implementation of XLFD is slightly broken for backward
5234 compatibility with previous broken versions, so test for
5235 wildcards as well as 0. */
5242 /* Value is non-zero if FONT1 is a better match for font attributes
5243 VALUES than FONT2. VALUES is an array of face attribute values in
5244 font sort order. COMPARE_PT_P zero means don't compare point
5248 better_font_p (values
, font1
, font2
, compare_pt_p
)
5250 struct font_name
*font1
, *font2
;
5255 for (i
= 0; i
< 4; ++i
)
5257 int xlfd_idx
= font_sort_order
[i
];
5259 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5261 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5262 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5264 if (delta1
> delta2
)
5266 else if (delta1
< delta2
)
5270 /* The difference may be equal because, e.g., the face
5271 specifies `italic' but we have only `regular' and
5272 `oblique'. Prefer `oblique' in this case. */
5273 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5274 && font1
->numeric
[xlfd_idx
] > values
[i
]
5275 && font2
->numeric
[xlfd_idx
] < values
[i
])
5287 /* Value is non-zero if FONT is an exact match for face attributes in
5288 SPECIFIED. SPECIFIED is an array of face attribute values in font
5292 exact_face_match_p (specified
, font
)
5294 struct font_name
*font
;
5298 for (i
= 0; i
< 4; ++i
)
5299 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5306 /* Value is the name of a scaled font, generated from scalable font
5307 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5308 Value is allocated from heap. */
5311 build_scalable_font_name (f
, font
, specified_pt
)
5313 struct font_name
*font
;
5316 char point_size
[20], pixel_size
[20];
5318 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5321 /* If scalable font is for a specific resolution, compute
5322 the point size we must specify from the resolution of
5323 the display and the specified resolution of the font. */
5324 if (font
->numeric
[XLFD_RESY
] != 0)
5326 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5327 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5332 pixel_value
= resy
/ 720.0 * pt
;
5335 /* Set point size of the font. */
5336 sprintf (point_size
, "%d", (int) pt
);
5337 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5338 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5340 /* Set pixel size. */
5341 sprintf (pixel_size
, "%d", pixel_value
);
5342 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5343 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5345 /* If font doesn't specify its resolution, use the
5346 resolution of the display. */
5347 if (font
->numeric
[XLFD_RESY
] == 0)
5350 sprintf (buffer
, "%d", (int) resy
);
5351 font
->fields
[XLFD_RESY
] = buffer
;
5352 font
->numeric
[XLFD_RESY
] = resy
;
5355 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5358 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5359 sprintf (buffer
, "%d", resx
);
5360 font
->fields
[XLFD_RESX
] = buffer
;
5361 font
->numeric
[XLFD_RESX
] = resx
;
5364 return build_font_name (font
);
5368 /* Value is non-zero if we are allowed to use scalable font FONT. We
5369 can't run a Lisp function here since this function may be called
5370 with input blocked. */
5373 may_use_scalable_font_p (font
, name
)
5374 struct font_name
*font
;
5377 if (EQ (Vscalable_fonts_allowed
, Qt
))
5379 else if (CONSP (Vscalable_fonts_allowed
))
5381 Lisp_Object tail
, regexp
;
5383 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5385 regexp
= XCAR (tail
);
5386 if (STRINGP (regexp
)
5387 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5395 #endif /* SCALABLE_FONTS != 0 */
5398 /* Return the name of the best matching font for face attributes
5399 ATTRS in the array of font_name structures FONTS which contains
5400 NFONTS elements. Value is a font name which is allocated from
5401 the heap. FONTS is freed by this function. */
5404 best_matching_font (f
, attrs
, fonts
, nfonts
)
5407 struct font_name
*fonts
;
5411 struct font_name
*best
;
5419 /* Make specified font attributes available in `specified',
5420 indexed by sort order. */
5421 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5423 int xlfd_idx
= font_sort_order
[i
];
5425 if (xlfd_idx
== XLFD_SWIDTH
)
5426 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5427 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5428 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5429 else if (xlfd_idx
== XLFD_WEIGHT
)
5430 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5431 else if (xlfd_idx
== XLFD_SLANT
)
5432 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5442 /* Start with the first non-scalable font in the list. */
5443 for (i
= 0; i
< nfonts
; ++i
)
5444 if (!font_scalable_p (fonts
+ i
))
5447 /* Find the best match among the non-scalable fonts. */
5452 for (i
= 1; i
< nfonts
; ++i
)
5453 if (!font_scalable_p (fonts
+ i
)
5454 && better_font_p (specified
, fonts
+ i
, best
, 1))
5458 exact_p
= exact_face_match_p (specified
, best
);
5467 /* Unless we found an exact match among non-scalable fonts, see if
5468 we can find a better match among scalable fonts. */
5471 /* A scalable font is better if
5473 1. its weight, slant, swidth attributes are better, or.
5475 2. the best non-scalable font doesn't have the required
5476 point size, and the scalable fonts weight, slant, swidth
5479 int non_scalable_has_exact_height_p
;
5481 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5482 non_scalable_has_exact_height_p
= 1;
5484 non_scalable_has_exact_height_p
= 0;
5486 for (i
= 0; i
< nfonts
; ++i
)
5487 if (font_scalable_p (fonts
+ i
))
5490 || better_font_p (specified
, fonts
+ i
, best
, 0)
5491 || (!non_scalable_has_exact_height_p
5492 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5497 if (font_scalable_p (best
))
5498 font_name
= build_scalable_font_name (f
, best
, pt
);
5500 font_name
= build_font_name (best
);
5502 #else /* !SCALABLE_FONTS */
5504 /* Find the best non-scalable font. */
5507 for (i
= 1; i
< nfonts
; ++i
)
5509 xassert (!font_scalable_p (fonts
+ i
));
5510 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5514 font_name
= build_font_name (best
);
5516 #endif /* !SCALABLE_FONTS */
5518 /* Free font_name structures. */
5519 free_font_names (fonts
, nfonts
);
5525 /* Try to get a list of fonts on frame F with font family FAMILY and
5526 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5527 of font_name structures for the fonts matched. Value is the number
5531 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5534 Lisp_Object pattern
, family
, registry
;
5535 struct font_name
**fonts
;
5539 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5540 family
= attrs
[LFACE_FAMILY_INDEX
];
5542 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5544 if (nfonts
== 0 && !NILP (family
))
5548 /* Try alternative font families from
5549 Vface_alternative_font_family_alist. */
5550 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5552 for (alter
= XCDR (alter
);
5553 CONSP (alter
) && nfonts
== 0;
5554 alter
= XCDR (alter
))
5556 if (STRINGP (XCAR (alter
)))
5557 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5560 /* Try font family of the default face or "fixed". */
5563 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5565 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5567 family
= build_string ("fixed");
5568 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5571 /* Try any family with the given registry. */
5573 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5580 /* Return the fontset id of the base fontset name or alias name given
5581 by the fontset attribute of ATTRS. Value is -1 if the fontset
5582 attribute of ATTRS doesn't name a fontset. */
5585 face_fontset (attrs
)
5591 name
= attrs
[LFACE_FONT_INDEX
];
5592 if (!STRINGP (name
))
5594 return fs_query_fontset (name
, 0);
5598 /* Choose a name of font to use on frame F to display character C with
5599 Lisp face attributes specified by ATTRS. The font name is
5600 determined by the font-related attributes in ATTRS and the name
5601 pattern for C in FONTSET. Value is the font name which is
5602 allocated from the heap and must be freed by the caller, or NULL if
5603 we can get no information about the font name of C. It is assured
5604 that we always get some information for a single byte
5608 choose_face_font (f
, attrs
, fontset
, c
)
5613 Lisp_Object pattern
;
5614 char *font_name
= NULL
;
5615 struct font_name
*fonts
;
5618 /* Get (foundry and) family name and registry (and encoding) name of
5620 pattern
= fontset_font_pattern (f
, fontset
, c
);
5623 xassert (!SINGLE_BYTE_CHAR_P (c
));
5626 /* If what we got is a name pattern, return it. */
5627 if (STRINGP (pattern
))
5628 return xstrdup (XSTRING (pattern
)->data
);
5630 /* Family name may be specified both in ATTRS and car part of
5631 PATTERN. The former has higher priority if C is a single byte
5633 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5634 && SINGLE_BYTE_CHAR_P (c
))
5635 XCAR (pattern
) = Qnil
;
5637 /* Get a list of fonts matching that pattern and choose the
5638 best match for the specified face attributes from it. */
5639 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
5641 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5645 #endif /* HAVE_WINDOW_SYSTEM */
5649 /***********************************************************************
5651 ***********************************************************************/
5653 /* Realize basic faces on frame F. Value is zero if frame parameters
5654 of F don't contain enough information needed to realize the default
5658 realize_basic_faces (f
)
5663 /* Block input there so that we won't be surprised by an X expose
5664 event, for instance without having the faces set up. */
5667 if (realize_default_face (f
))
5669 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5670 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5671 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5672 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5673 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5674 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5675 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5676 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5677 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5686 /* Realize the default face on frame F. If the face is not fully
5687 specified, make it fully-specified. Attributes of the default face
5688 that are not explicitly specified are taken from frame parameters. */
5691 realize_default_face (f
)
5694 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5696 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5697 Lisp_Object frame_font
;
5701 /* If the `default' face is not yet known, create it. */
5702 lface
= lface_from_face_name (f
, Qdefault
, 0);
5706 XSETFRAME (frame
, f
);
5707 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5710 #ifdef HAVE_WINDOW_SYSTEM
5711 if (FRAME_WINDOW_P (f
))
5713 /* Set frame_font to the value of the `font' frame parameter. */
5714 frame_font
= Fassq (Qfont
, f
->param_alist
);
5715 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5716 frame_font
= XCDR (frame_font
);
5717 set_lface_from_font_name (f
, lface
, frame_font
, 0, 1);
5719 #endif /* HAVE_WINDOW_SYSTEM */
5721 if (!FRAME_WINDOW_P (f
))
5723 LFACE_FAMILY (lface
) = build_string ("default");
5724 LFACE_SWIDTH (lface
) = Qnormal
;
5725 LFACE_HEIGHT (lface
) = make_number (1);
5726 LFACE_WEIGHT (lface
) = Qnormal
;
5727 LFACE_SLANT (lface
) = Qnormal
;
5730 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5731 LFACE_UNDERLINE (lface
) = Qnil
;
5733 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5734 LFACE_OVERLINE (lface
) = Qnil
;
5736 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5737 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5739 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5740 LFACE_BOX (lface
) = Qnil
;
5742 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5743 LFACE_INVERSE (lface
) = Qnil
;
5745 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5747 /* This function is called so early that colors are not yet
5748 set in the frame parameter list. */
5749 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5751 if (CONSP (color
) && STRINGP (XCDR (color
)))
5752 LFACE_FOREGROUND (lface
) = XCDR (color
);
5753 else if (FRAME_WINDOW_P (f
))
5755 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5756 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5761 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5763 /* This function is called so early that colors are not yet
5764 set in the frame parameter list. */
5765 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5766 if (CONSP (color
) && STRINGP (XCDR (color
)))
5767 LFACE_BACKGROUND (lface
) = XCDR (color
);
5768 else if (FRAME_WINDOW_P (f
))
5770 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5771 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5776 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5777 LFACE_STIPPLE (lface
) = Qnil
;
5779 /* Realize the face; it must be fully-specified now. */
5780 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5781 check_lface (lface
);
5782 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5783 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
5788 /* Realize basic faces other than the default face in face cache C.
5789 SYMBOL is the face name, ID is the face id the realized face must
5790 have. The default face must have been realized already. */
5793 realize_named_face (f
, symbol
, id
)
5798 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5799 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5800 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5801 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5802 struct face
*new_face
;
5804 /* The default face must exist and be fully specified. */
5805 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5806 check_lface_attrs (attrs
);
5807 xassert (lface_fully_specified_p (attrs
));
5809 /* If SYMBOL isn't know as a face, create it. */
5813 XSETFRAME (frame
, f
);
5814 lface
= Finternal_make_lisp_face (symbol
, frame
);
5817 /* Merge SYMBOL's face with the default face. */
5818 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5819 merge_face_vectors (symbol_attrs
, attrs
);
5821 /* Realize the face. */
5822 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
5826 /* Realize the fully-specified face with attributes ATTRS in face
5827 cache CACHE for character C. If C is a multibyte character,
5828 BASE_FACE is a face that has the same attributes. Otherwise,
5829 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
5830 ID of face to remove before caching the new face. Value is a
5831 pointer to the newly created realized face. */
5833 static struct face
*
5834 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
5835 struct face_cache
*cache
;
5838 struct face
*base_face
;
5843 /* LFACE must be fully specified. */
5844 xassert (cache
!= NULL
);
5845 check_lface_attrs (attrs
);
5847 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5849 /* Remove the former face. */
5850 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5851 uncache_face (cache
, former_face
);
5852 free_realized_face (cache
->f
, former_face
);
5855 if (FRAME_WINDOW_P (cache
->f
))
5856 face
= realize_x_face (cache
, attrs
, c
, base_face
);
5857 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5858 face
= realize_tty_face (cache
, attrs
, c
);
5862 /* Insert the new face. */
5863 cache_face (cache
, face
, lface_hash (attrs
));
5864 #ifdef HAVE_WINDOW_SYSTEM
5865 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
5866 load_face_font (cache
->f
, face
, c
);
5867 #endif /* HAVE_WINDOW_SYSTEM */
5872 /* Realize the fully-specified face with attributes ATTRS in face
5873 cache CACHE for character C. Do it for X frame CACHE->f. If C is
5874 a multibyte character, BASE_FACE is a face that has the same
5875 attributes. Otherwise, BASE_FACE is ignored. If the new face
5876 doesn't share font with the default face, a fontname is allocated
5877 from the heap and set in `font_name' of the new face, but it is not
5878 yet loaded here. Value is a pointer to the newly created realized
5881 static struct face
*
5882 realize_x_face (cache
, attrs
, c
, base_face
)
5883 struct face_cache
*cache
;
5886 struct face
*base_face
;
5888 #ifdef HAVE_WINDOW_SYSTEM
5889 struct face
*face
, *default_face
;
5891 Lisp_Object stipple
, overline
, strike_through
, box
;
5893 xassert (FRAME_WINDOW_P (cache
->f
));
5894 xassert (SINGLE_BYTE_CHAR_P (c
)
5897 /* Allocate a new realized face. */
5898 face
= make_realized_face (attrs
);
5902 /* If C is a multibyte character, we share all face attirbutes with
5903 BASE_FACE including the realized fontset. But, we must load a
5905 if (!SINGLE_BYTE_CHAR_P (c
))
5907 bcopy (base_face
, face
, sizeof *face
);
5910 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5911 face
->foreground_defaulted_p
= 1;
5912 face
->background_defaulted_p
= 1;
5913 face
->underline_defaulted_p
= 1;
5914 face
->overline_color_defaulted_p
= 1;
5915 face
->strike_through_color_defaulted_p
= 1;
5916 face
->box_color_defaulted_p
= 1;
5918 /* to force realize_face to load font */
5923 /* Now we are realizing a face for ASCII (and unibyte) characters. */
5925 /* Determine the font to use. Most of the time, the font will be
5926 the same as the font of the default face, so try that first. */
5927 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5929 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
5930 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5932 face
->font
= default_face
->font
;
5933 face
->fontset
= default_face
->fontset
;
5934 face
->font_info_id
= default_face
->font_info_id
;
5935 face
->font_name
= default_face
->font_name
;
5936 face
->ascii_face
= face
;
5938 /* But, as we can't share the fontset, make a new realized
5939 fontset that has the same base fontset as of the default
5942 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
5946 /* If the face attribute ATTRS specifies a fontset, use it as
5947 the base of a new realized fontset. Otherwise, use the same
5948 base fontset as of the default face. The base determines
5949 registry and encoding of a font. It may also determine
5950 foundry and family. The other fields of font name pattern
5951 are constructed from ATTRS. */
5952 int fontset
= face_fontset (attrs
);
5954 if ((fontset
== -1) && default_face
)
5955 fontset
= default_face
->fontset
;
5956 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
5957 face
->font
= NULL
; /* to force realize_face to load font */
5960 /* Load colors, and set remaining attributes. */
5962 load_face_colors (f
, face
, attrs
);
5965 box
= attrs
[LFACE_BOX_INDEX
];
5968 /* A simple box of line width 1 drawn in color given by
5970 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5972 face
->box
= FACE_SIMPLE_BOX
;
5973 face
->box_line_width
= 1;
5975 else if (INTEGERP (box
))
5977 /* Simple box of specified line width in foreground color of the
5979 xassert (XINT (box
) > 0);
5980 face
->box
= FACE_SIMPLE_BOX
;
5981 face
->box_line_width
= XFASTINT (box
);
5982 face
->box_color
= face
->foreground
;
5983 face
->box_color_defaulted_p
= 1;
5985 else if (CONSP (box
))
5987 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5988 being one of `raised' or `sunken'. */
5989 face
->box
= FACE_SIMPLE_BOX
;
5990 face
->box_color
= face
->foreground
;
5991 face
->box_color_defaulted_p
= 1;
5992 face
->box_line_width
= 1;
5996 Lisp_Object keyword
, value
;
5998 keyword
= XCAR (box
);
6006 if (EQ (keyword
, QCline_width
))
6008 if (INTEGERP (value
) && XINT (value
) > 0)
6009 face
->box_line_width
= XFASTINT (value
);
6011 else if (EQ (keyword
, QCcolor
))
6013 if (STRINGP (value
))
6015 face
->box_color
= load_color (f
, face
, value
,
6017 face
->use_box_color_for_shadows_p
= 1;
6020 else if (EQ (keyword
, QCstyle
))
6022 if (EQ (value
, Qreleased_button
))
6023 face
->box
= FACE_RAISED_BOX
;
6024 else if (EQ (value
, Qpressed_button
))
6025 face
->box
= FACE_SUNKEN_BOX
;
6030 /* Text underline, overline, strike-through. */
6032 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6034 /* Use default color (same as foreground color). */
6035 face
->underline_p
= 1;
6036 face
->underline_defaulted_p
= 1;
6037 face
->underline_color
= 0;
6039 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6041 /* Use specified color. */
6042 face
->underline_p
= 1;
6043 face
->underline_defaulted_p
= 0;
6044 face
->underline_color
6045 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6046 LFACE_UNDERLINE_INDEX
);
6048 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6050 face
->underline_p
= 0;
6051 face
->underline_defaulted_p
= 0;
6052 face
->underline_color
= 0;
6055 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6056 if (STRINGP (overline
))
6058 face
->overline_color
6059 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6060 LFACE_OVERLINE_INDEX
);
6061 face
->overline_p
= 1;
6063 else if (EQ (overline
, Qt
))
6065 face
->overline_color
= face
->foreground
;
6066 face
->overline_color_defaulted_p
= 1;
6067 face
->overline_p
= 1;
6070 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6071 if (STRINGP (strike_through
))
6073 face
->strike_through_color
6074 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6075 LFACE_STRIKE_THROUGH_INDEX
);
6076 face
->strike_through_p
= 1;
6078 else if (EQ (strike_through
, Qt
))
6080 face
->strike_through_color
= face
->foreground
;
6081 face
->strike_through_color_defaulted_p
= 1;
6082 face
->strike_through_p
= 1;
6085 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6086 if (!NILP (stipple
))
6087 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6089 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6091 #endif /* HAVE_WINDOW_SYSTEM */
6095 /* Map a specified color of face FACE on frame F to a tty color index.
6096 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6097 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6098 default foreground/background colors. */
6101 map_tty_color (f
, face
, idx
, defaulted
)
6104 enum lface_attribute_index idx
;
6107 Lisp_Object frame
, color
, def
;
6108 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6109 unsigned long default_pixel
, default_other_pixel
, pixel
;
6111 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6115 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6116 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6120 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6121 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6124 XSETFRAME (frame
, f
);
6125 color
= face
->lface
[idx
];
6128 && XSTRING (color
)->size
6129 && CONSP (Vtty_defined_color_alist
)
6130 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6133 /* Associations in tty-defined-color-alist are of the form
6134 (NAME INDEX R G B). We need the INDEX part. */
6135 pixel
= XINT (XCAR (XCDR (def
)));
6138 if (pixel
== default_pixel
&& STRINGP (color
))
6140 pixel
= load_color (f
, face
, color
, idx
);
6142 #if defined (MSDOS) || defined (WINDOWSNT)
6143 /* If the foreground of the default face is the default color,
6144 use the foreground color defined by the frame. */
6146 if (FRAME_MSDOS_P (f
))
6149 if (pixel
== default_pixel
6150 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6153 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6155 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6156 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6159 else if (pixel
== default_other_pixel
)
6162 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6164 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6165 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6171 #endif /* MSDOS or WINDOWSNT */
6175 face
->foreground
= pixel
;
6177 face
->background
= pixel
;
6181 /* Realize the fully-specified face with attributes ATTRS in face
6182 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6183 pointer to the newly created realized face. */
6185 static struct face
*
6186 realize_tty_face (cache
, attrs
, c
)
6187 struct face_cache
*cache
;
6193 int face_colors_defaulted
= 0;
6194 struct frame
*f
= cache
->f
;
6196 /* Frame must be a termcap frame. */
6197 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6199 /* Allocate a new realized face. */
6200 face
= make_realized_face (attrs
);
6201 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6203 /* Map face attributes to TTY appearances. We map slant to
6204 dimmed text because we want italic text to appear differently
6205 and because dimmed text is probably used infrequently. */
6206 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6207 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6209 if (weight
> XLFD_WEIGHT_MEDIUM
)
6210 face
->tty_bold_p
= 1;
6211 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6212 face
->tty_dim_p
= 1;
6213 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6214 face
->tty_underline_p
= 1;
6215 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6216 face
->tty_reverse_p
= 1;
6218 /* Map color names to color indices. */
6219 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6220 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6222 /* Swap colors if face is inverse-video. If the colors are taken
6223 from the frame colors, they are already inverted, since the
6224 frame-creation function calls x-handle-reverse-video. */
6225 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6227 unsigned long tem
= face
->foreground
;
6228 face
->foreground
= face
->background
;
6229 face
->background
= tem
;
6232 if (tty_suppress_bold_inverse_default_colors_p
6234 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6235 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6236 face
->tty_bold_p
= 0;
6242 DEFUN ("tty-suppress-bold-inverse-default-colors",
6243 Ftty_suppress_bold_inverse_default_colors
,
6244 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6245 "Suppress/allow boldness of faces with inverse default colors.\n\
6246 SUPPRESS non-nil means suppress it.\n\
6247 This affects bold faces on TTYs whose foreground is the default background\n\
6248 color of the display and whose background is the default foreground color.\n\
6249 For such faces, the bold face attribute is ignored if this variable\n\
6252 Lisp_Object suppress
;
6254 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6255 ++face_change_count
;
6261 /***********************************************************************
6263 ***********************************************************************/
6265 /* Return the ID of the face to use to display character CH with face
6266 property PROP on frame F in current_buffer. */
6269 compute_char_face (f
, ch
, prop
)
6276 if (NILP (current_buffer
->enable_multibyte_characters
))
6281 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6282 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6286 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6287 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6288 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6289 merge_face_vector_with_property (f
, attrs
, prop
);
6290 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6297 /* Return the face ID associated with buffer position POS for
6298 displaying ASCII characters. Return in *ENDPTR the position at
6299 which a different face is needed, as far as text properties and
6300 overlays are concerned. W is a window displaying current_buffer.
6302 REGION_BEG, REGION_END delimit the region, so it can be
6305 LIMIT is a position not to scan beyond. That is to limit the time
6306 this function can take.
6308 If MOUSE is non-zero, use the character's mouse-face, not its face.
6310 The face returned is suitable for displaying ASCII characters. */
6313 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6314 endptr
, limit
, mouse
)
6317 int region_beg
, region_end
;
6322 struct frame
*f
= XFRAME (w
->frame
);
6323 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6324 Lisp_Object prop
, position
;
6326 Lisp_Object
*overlay_vec
;
6329 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6330 Lisp_Object limit1
, end
;
6331 struct face
*default_face
;
6332 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6334 /* W must display the current buffer. We could write this function
6335 to use the frame and buffer of W, but right now it doesn't. */
6336 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6338 XSETFRAME (frame
, f
);
6339 XSETFASTINT (position
, pos
);
6342 if (pos
< region_beg
&& region_beg
< endpos
)
6343 endpos
= region_beg
;
6345 /* Get the `face' or `mouse_face' text property at POS, and
6346 determine the next position at which the property changes. */
6347 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6348 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6349 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6351 endpos
= XINT (end
);
6353 /* Look at properties from overlays. */
6358 /* First try with room for 40 overlays. */
6360 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6361 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6362 &next_overlay
, NULL
, 0);
6364 /* If there are more than 40, make enough space for all, and try
6366 if (noverlays
> len
)
6369 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6370 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6371 &next_overlay
, NULL
, 0);
6374 if (next_overlay
< endpos
)
6375 endpos
= next_overlay
;
6380 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6382 /* Optimize common cases where we can use the default face. */
6385 && !(pos
>= region_beg
&& pos
< region_end
))
6386 return DEFAULT_FACE_ID
;
6388 /* Begin with attributes from the default face. */
6389 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6391 /* Merge in attributes specified via text properties. */
6393 merge_face_vector_with_property (f
, attrs
, prop
);
6395 /* Now merge the overlay data. */
6396 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6397 for (i
= 0; i
< noverlays
; i
++)
6402 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6404 merge_face_vector_with_property (f
, attrs
, prop
);
6406 oend
= OVERLAY_END (overlay_vec
[i
]);
6407 oendpos
= OVERLAY_POSITION (oend
);
6408 if (oendpos
< endpos
)
6412 /* If in the region, merge in the region face. */
6413 if (pos
>= region_beg
&& pos
< region_end
)
6415 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6416 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6418 if (region_end
< endpos
)
6419 endpos
= region_end
;
6424 /* Look up a realized face with the given face attributes,
6425 or realize a new one for ASCII characters. */
6426 return lookup_face (f
, attrs
, 0, NULL
);
6430 /* Compute the face at character position POS in Lisp string STRING on
6431 window W, for ASCII characters.
6433 If STRING is an overlay string, it comes from position BUFPOS in
6434 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6435 not an overlay string. W must display the current buffer.
6436 REGION_BEG and REGION_END give the start and end positions of the
6437 region; both are -1 if no region is visible. BASE_FACE_ID is the
6438 id of the basic face to merge with. It is usually equal to
6439 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6440 for strings displayed in the mode or top line.
6442 Set *ENDPTR to the next position where to check for faces in
6443 STRING; -1 if the face is constant from POS to the end of the
6446 Value is the id of the face to use. The face returned is suitable
6447 for displaying ASCII characters. */
6450 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6451 region_end
, endptr
, base_face_id
)
6455 int region_beg
, region_end
;
6457 enum face_id base_face_id
;
6459 Lisp_Object prop
, position
, end
, limit
;
6460 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6461 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6462 struct face
*base_face
;
6463 int multibyte_p
= STRING_MULTIBYTE (string
);
6465 /* Get the value of the face property at the current position within
6466 STRING. Value is nil if there is no face property. */
6467 XSETFASTINT (position
, pos
);
6468 prop
= Fget_text_property (position
, Qface
, string
);
6470 /* Get the next position at which to check for faces. Value of end
6471 is nil if face is constant all the way to the end of the string.
6472 Otherwise it is a string position where to check faces next.
6473 Limit is the maximum position up to which to check for property
6474 changes in Fnext_single_property_change. Strings are usually
6475 short, so set the limit to the end of the string. */
6476 XSETFASTINT (limit
, XSTRING (string
)->size
);
6477 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6479 *endptr
= XFASTINT (end
);
6483 base_face
= FACE_FROM_ID (f
, base_face_id
);
6484 xassert (base_face
);
6486 /* Optimize the default case that there is no face property and we
6487 are not in the region. */
6489 && (base_face_id
!= DEFAULT_FACE_ID
6490 /* BUFPOS <= 0 means STRING is not an overlay string, so
6491 that the region doesn't have to be taken into account. */
6493 || bufpos
< region_beg
6494 || bufpos
>= region_end
)
6496 /* We can't realize faces for different charsets differently
6497 if we don't have fonts, so we can stop here if not working
6498 on a window-system frame. */
6499 || !FRAME_WINDOW_P (f
)
6500 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6501 return base_face
->id
;
6503 /* Begin with attributes from the base face. */
6504 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6506 /* Merge in attributes specified via text properties. */
6508 merge_face_vector_with_property (f
, attrs
, prop
);
6510 /* If in the region, merge in the region face. */
6512 && bufpos
>= region_beg
6513 && bufpos
< region_end
)
6515 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6516 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6519 /* Look up a realized face with the given face attributes,
6520 or realize a new one for ASCII characters. */
6521 return lookup_face (f
, attrs
, 0, NULL
);
6526 /***********************************************************************
6528 ***********************************************************************/
6532 /* Print the contents of the realized face FACE to stderr. */
6535 dump_realized_face (face
)
6538 fprintf (stderr
, "ID: %d\n", face
->id
);
6539 #ifdef HAVE_X_WINDOWS
6540 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6542 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6544 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6545 fprintf (stderr
, "background: 0x%lx (%s)\n",
6547 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6548 fprintf (stderr
, "font_name: %s (%s)\n",
6550 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6551 #ifdef HAVE_X_WINDOWS
6552 fprintf (stderr
, "font = %p\n", face
->font
);
6554 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6555 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6556 fprintf (stderr
, "underline: %d (%s)\n",
6558 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6559 fprintf (stderr
, "hash: %d\n", face
->hash
);
6560 fprintf (stderr
, "charset: %d\n", face
->charset
);
6564 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6572 fprintf (stderr
, "font selection order: ");
6573 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6574 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6575 fprintf (stderr
, "\n");
6577 fprintf (stderr
, "alternative fonts: ");
6578 debug_print (Vface_alternative_font_family_alist
);
6579 fprintf (stderr
, "\n");
6581 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6582 Fdump_face (make_number (i
));
6587 CHECK_NUMBER (n
, 0);
6588 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6590 error ("Not a valid face");
6591 dump_realized_face (face
);
6598 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6602 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6603 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6604 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6608 #endif /* GLYPH_DEBUG != 0 */
6612 /***********************************************************************
6614 ***********************************************************************/
6619 Qface
= intern ("face");
6621 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6622 staticpro (&Qbitmap_spec_p
);
6623 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6624 staticpro (&Qframe_update_face_colors
);
6626 /* Lisp face attribute keywords. */
6627 QCfamily
= intern (":family");
6628 staticpro (&QCfamily
);
6629 QCheight
= intern (":height");
6630 staticpro (&QCheight
);
6631 QCweight
= intern (":weight");
6632 staticpro (&QCweight
);
6633 QCslant
= intern (":slant");
6634 staticpro (&QCslant
);
6635 QCunderline
= intern (":underline");
6636 staticpro (&QCunderline
);
6637 QCinverse_video
= intern (":inverse-video");
6638 staticpro (&QCinverse_video
);
6639 QCreverse_video
= intern (":reverse-video");
6640 staticpro (&QCreverse_video
);
6641 QCforeground
= intern (":foreground");
6642 staticpro (&QCforeground
);
6643 QCbackground
= intern (":background");
6644 staticpro (&QCbackground
);
6645 QCstipple
= intern (":stipple");;
6646 staticpro (&QCstipple
);
6647 QCwidth
= intern (":width");
6648 staticpro (&QCwidth
);
6649 QCfont
= intern (":font");
6650 staticpro (&QCfont
);
6651 QCbold
= intern (":bold");
6652 staticpro (&QCbold
);
6653 QCitalic
= intern (":italic");
6654 staticpro (&QCitalic
);
6655 QCoverline
= intern (":overline");
6656 staticpro (&QCoverline
);
6657 QCstrike_through
= intern (":strike-through");
6658 staticpro (&QCstrike_through
);
6659 QCbox
= intern (":box");
6662 /* Symbols used for Lisp face attribute values. */
6663 QCcolor
= intern (":color");
6664 staticpro (&QCcolor
);
6665 QCline_width
= intern (":line-width");
6666 staticpro (&QCline_width
);
6667 QCstyle
= intern (":style");
6668 staticpro (&QCstyle
);
6669 Qreleased_button
= intern ("released-button");
6670 staticpro (&Qreleased_button
);
6671 Qpressed_button
= intern ("pressed-button");
6672 staticpro (&Qpressed_button
);
6673 Qnormal
= intern ("normal");
6674 staticpro (&Qnormal
);
6675 Qultra_light
= intern ("ultra-light");
6676 staticpro (&Qultra_light
);
6677 Qextra_light
= intern ("extra-light");
6678 staticpro (&Qextra_light
);
6679 Qlight
= intern ("light");
6680 staticpro (&Qlight
);
6681 Qsemi_light
= intern ("semi-light");
6682 staticpro (&Qsemi_light
);
6683 Qsemi_bold
= intern ("semi-bold");
6684 staticpro (&Qsemi_bold
);
6685 Qbold
= intern ("bold");
6687 Qextra_bold
= intern ("extra-bold");
6688 staticpro (&Qextra_bold
);
6689 Qultra_bold
= intern ("ultra-bold");
6690 staticpro (&Qultra_bold
);
6691 Qoblique
= intern ("oblique");
6692 staticpro (&Qoblique
);
6693 Qitalic
= intern ("italic");
6694 staticpro (&Qitalic
);
6695 Qreverse_oblique
= intern ("reverse-oblique");
6696 staticpro (&Qreverse_oblique
);
6697 Qreverse_italic
= intern ("reverse-italic");
6698 staticpro (&Qreverse_italic
);
6699 Qultra_condensed
= intern ("ultra-condensed");
6700 staticpro (&Qultra_condensed
);
6701 Qextra_condensed
= intern ("extra-condensed");
6702 staticpro (&Qextra_condensed
);
6703 Qcondensed
= intern ("condensed");
6704 staticpro (&Qcondensed
);
6705 Qsemi_condensed
= intern ("semi-condensed");
6706 staticpro (&Qsemi_condensed
);
6707 Qsemi_expanded
= intern ("semi-expanded");
6708 staticpro (&Qsemi_expanded
);
6709 Qexpanded
= intern ("expanded");
6710 staticpro (&Qexpanded
);
6711 Qextra_expanded
= intern ("extra-expanded");
6712 staticpro (&Qextra_expanded
);
6713 Qultra_expanded
= intern ("ultra-expanded");
6714 staticpro (&Qultra_expanded
);
6715 Qbackground_color
= intern ("background-color");
6716 staticpro (&Qbackground_color
);
6717 Qforeground_color
= intern ("foreground-color");
6718 staticpro (&Qforeground_color
);
6719 Qunspecified
= intern ("unspecified");
6720 staticpro (&Qunspecified
);
6722 Qface_alias
= intern ("face-alias");
6723 staticpro (&Qface_alias
);
6724 Qdefault
= intern ("default");
6725 staticpro (&Qdefault
);
6726 Qtool_bar
= intern ("tool-bar");
6727 staticpro (&Qtool_bar
);
6728 Qregion
= intern ("region");
6729 staticpro (&Qregion
);
6730 Qfringe
= intern ("fringe");
6731 staticpro (&Qfringe
);
6732 Qheader_line
= intern ("header-line");
6733 staticpro (&Qheader_line
);
6734 Qscroll_bar
= intern ("scroll-bar");
6735 staticpro (&Qscroll_bar
);
6736 Qmenu
= intern ("menu");
6738 Qcursor
= intern ("cursor");
6739 staticpro (&Qcursor
);
6740 Qborder
= intern ("border");
6741 staticpro (&Qborder
);
6742 Qmouse
= intern ("mouse");
6743 staticpro (&Qmouse
);
6744 Qtty_color_desc
= intern ("tty-color-desc");
6745 staticpro (&Qtty_color_desc
);
6746 Qtty_color_by_index
= intern ("tty-color-by-index");
6747 staticpro (&Qtty_color_by_index
);
6748 Qtty_color_alist
= intern ("tty-color-alist");
6749 staticpro (&Qtty_color_alist
);
6751 Vface_alternative_font_family_alist
= Qnil
;
6752 staticpro (&Vface_alternative_font_family_alist
);
6754 defsubr (&Sinternal_make_lisp_face
);
6755 defsubr (&Sinternal_lisp_face_p
);
6756 defsubr (&Sinternal_set_lisp_face_attribute
);
6757 #ifdef HAVE_WINDOW_SYSTEM
6758 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6760 defsubr (&Scolor_gray_p
);
6761 defsubr (&Scolor_supported_p
);
6762 defsubr (&Sinternal_get_lisp_face_attribute
);
6763 defsubr (&Sinternal_lisp_face_attribute_values
);
6764 defsubr (&Sinternal_lisp_face_equal_p
);
6765 defsubr (&Sinternal_lisp_face_empty_p
);
6766 defsubr (&Sinternal_copy_lisp_face
);
6767 defsubr (&Sinternal_merge_in_global_face
);
6768 defsubr (&Sface_font
);
6769 defsubr (&Sframe_face_alist
);
6770 defsubr (&Sinternal_set_font_selection_order
);
6771 defsubr (&Sinternal_set_alternative_font_family_alist
);
6773 defsubr (&Sdump_face
);
6774 defsubr (&Sshow_face_resources
);
6775 #endif /* GLYPH_DEBUG */
6776 defsubr (&Sclear_face_cache
);
6777 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6779 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6780 defsubr (&Sdump_colors
);
6783 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6784 "*Limit for font matching.\n\
6785 If an integer > 0, font matching functions won't load more than\n\
6786 that number of fonts when searching for a matching font.");
6787 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6789 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6790 "List of global face definitions (for internal use only.)");
6791 Vface_new_frame_defaults
= Qnil
;
6793 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6794 "*Default stipple pattern used on monochrome displays.\n\
6795 This stipple pattern is used on monochrome displays\n\
6796 instead of shades of gray for a face background color.\n\
6797 See `set-face-stipple' for possible values for this variable.");
6798 Vface_default_stipple
= build_string ("gray3");
6800 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
6801 "An alist of defined terminal colors and their RGB values.");
6802 Vtty_defined_color_alist
= Qnil
;
6806 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6807 "Allowed scalable fonts.\n\
6808 A value of nil means don't allow any scalable fonts.\n\
6809 A value of t means allow any scalable font.\n\
6810 Otherwise, value must be a list of regular expressions. A font may be\n\
6811 scaled if its name matches a regular expression in the list.");
6813 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
6814 by default limits the fonts available severely. */
6815 Vscalable_fonts_allowed
= Qt
;
6817 Vscalable_fonts_allowed
= Qnil
;
6819 #endif /* SCALABLE_FONTS */
6821 #ifdef HAVE_WINDOW_SYSTEM
6822 defsubr (&Sbitmap_spec_p
);
6823 defsubr (&Sx_list_fonts
);
6824 defsubr (&Sinternal_face_x_get_resource
);
6825 defsubr (&Sx_family_fonts
);
6826 defsubr (&Sx_font_family_list
);
6827 #endif /* HAVE_WINDOW_SYSTEM */