1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
25 When using Emacs with X, the display style of characters can be
26 changed by defining `faces'. Each face can specify the following
31 2. Relative proportionate width, aka character set width or set
32 width (swidth), e.g. `semi-compressed'.
34 3. Font height in 1/10pt.
36 4. Font weight, e.g. `bold'.
38 5. Font slant, e.g. `italic'.
44 8. Whether or not characters should be underlined, and in what color.
46 9. Whether or not characters should be displayed in inverse video.
48 10. A background stipple, a bitmap.
50 11. Whether or not characters should be overlined, and in what color.
52 12. Whether or not characters should be strike-through, and in what
55 13. Whether or not a box should be drawn around characters, the box
56 type, and, for simple boxes, in what color.
58 14. Font or fontset pattern, or nil. This is a special attribute.
59 When this attribyte is specified, the face uses a font opened by
60 that pattern as is. In addition, all the other font-related
61 attributes (1st thru 5th) are generated from the opened font name.
62 On the other hand, if one of the other font-related attributes are
63 specified, this attribute is set to nil. In that case, the face
64 doesn't inherit this attribute from the `default' face, and uses a
65 font determined by the other attributes (those may be inherited
66 from the `default' face).
68 Faces are frame-local by nature because Emacs allows to define the
69 same named face (face names are symbols) differently for different
70 frames. Each frame has an alist of face definitions for all named
71 faces. The value of a named face in such an alist is a Lisp vector
72 with the symbol `face' in slot 0, and a slot for each of the face
73 attributes mentioned above.
75 There is also a global face alist `Vface_new_frame_defaults'. Face
76 definitions from this list are used to initialize faces of newly
79 A face doesn't have to specify all attributes. Those not specified
80 have a value of `unspecified'. Faces specifying all attributes but
81 the 14th are called `fully-specified'.
86 The display style of a given character in the text is determined by
87 combining several faces. This process is called `face merging'.
88 Any aspect of the display style that isn't specified by overlays or
89 text properties is taken from the `default' face. Since it is made
90 sure that the default face is always fully-specified, face merging
91 always results in a fully-specified face.
96 After all face attributes for a character have been determined by
97 merging faces of that character, that face is `realized'. The
98 realization process maps face attributes to what is physically
99 available on the system where Emacs runs. The result is a
100 `realized face' in form of a struct face which is stored in the
101 face cache of the frame on which it was realized.
103 Face realization is done in the context of the character to display
104 because different fonts may be used for different characters. In
105 other words, for characters that have different font
106 specifications, different realized faces are needed to display
109 Font specification is done by fontsets. See the comment in
110 fontset.c for the details. In the current implementation, all ASCII
111 characters share the same font in a fontset.
113 Faces are at first realized for ASCII characters, and, at that
114 time, assigned a specific realized fontset. Hereafter, we call
115 such a face as `ASCII face'. When a face for a multibyte character
116 is realized, it inherits (thus shares) a fontset of an ASCII face
117 that has the same attributes other than font-related ones.
119 Thus, all realzied face have a realized fontset.
124 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
125 font as ASCII characters. That is because it is expected that
126 unibyte text users specify a font that is suitable both for ASCII
127 and raw 8-bit characters.
132 Font selection tries to find the best available matching font for a
133 given (character, face) combination.
135 If the face specifies a fontset name, that fontset determines a
136 pattern for fonts of the given character. If the face specifies a
137 font name or the other font-related attributes, a fontset is
138 realized from the default fontset. In that case, that
139 specification determines a pattern for ASCII characters and the
140 default fontset determines a pattern for multibyte characters.
142 Available fonts on the system on which Emacs runs are then matched
143 against the font pattern. The result of font selection is the best
144 match for the given face attributes in this font list.
146 Font selection can be influenced by the user.
148 1. The user can specify the relative importance he gives the face
149 attributes width, height, weight, and slant by setting
150 face-font-selection-order (faces.el) to a list of face attribute
151 names. The default is '(:width :height :weight :slant), and means
152 that font selection first tries to find a good match for the font
153 width specified by a face, then---within fonts with that
154 width---tries to find a best match for the specified font height,
157 2. Setting face-alternative-font-family-alist allows the user to
158 specify alternative font families to try if a family specified by a
162 Character compositition.
164 Usually, the realization process is already finished when Emacs
165 actually reflects the desired glyph matrix on the screen. However,
166 on displaying a composition (sequence of characters to be composed
167 on the screen), a suitable font for the components of the
168 composition is selected and realized while drawing them on the
169 screen, i.e. the realization process is delayed but in principle
173 Initialization of basic faces.
175 The faces `default', `modeline' are considered `basic faces'.
176 When redisplay happens the first time for a newly created frame,
177 basic faces are realized for CHARSET_ASCII. Frame parameters are
178 used to fill in unspecified attributes of the default face. */
180 /* Define SCALABLE_FONTS to a non-zero value to enable scalable
181 font use. Define it to zero to disable scalable font use.
183 Use of too many or too large scalable fonts can crash XFree86
184 servers. That's why I've put the code dealing with scalable fonts
187 #define SCALABLE_FONTS 1
190 #include <sys/types.h>
191 #include <sys/stat.h>
196 #ifdef HAVE_X_WINDOWS
201 #include <Xm/XmStrDefs.h>
202 #endif /* USE_MOTIF */
212 /* Redefine X specifics to W32 equivalents to avoid cluttering the
213 code with #ifdef blocks. */
214 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
215 #define x_display_info w32_display_info
216 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
217 #define check_x check_w32
218 #define x_list_fonts w32_list_fonts
219 #define GCGraphicsExposures 0
220 /* For historic reasons, FONT_WIDTH refers to average width on W32,
221 not maximum as on X. Redefine here. */
222 #define FONT_WIDTH FONT_MAX_WIDTH
226 #include "dispextern.h"
227 #include "blockinput.h"
229 #include "intervals.h"
231 #ifdef HAVE_X_WINDOWS
233 /* Compensate for a bug in Xos.h on some systems, on which it requires
234 time.h. On some such systems, Xos.h tries to redefine struct
235 timeval and struct timezone if USG is #defined while it is
238 #ifdef XOS_NEEDS_TIME_H
244 #else /* not XOS_NEEDS_TIME_H */
246 #endif /* not XOS_NEEDS_TIME_H */
248 #endif /* HAVE_X_WINDOWS */
252 #include "keyboard.h"
255 #define max(A, B) ((A) > (B) ? (A) : (B))
256 #define min(A, B) ((A) < (B) ? (A) : (B))
257 #define abs(X) ((X) < 0 ? -(X) : (X))
260 /* Non-zero if face attribute ATTR is unspecified. */
262 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
264 /* Value is the number of elements of VECTOR. */
266 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
268 /* Make a copy of string S on the stack using alloca. Value is a pointer
271 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
273 /* Make a copy of the contents of Lisp string S on the stack using
274 alloca. Value is a pointer to the copy. */
276 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
278 /* Size of hash table of realized faces in face caches (should be a
281 #define FACE_CACHE_BUCKETS_SIZE 1001
283 /* A definition of XColor for non-X frames. */
284 #ifndef HAVE_X_WINDOWS
287 unsigned short red
, green
, blue
;
293 /* Keyword symbols used for face attribute names. */
295 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
296 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
297 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
298 Lisp_Object QCreverse_video
;
299 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
301 /* Symbols used for attribute values. */
303 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
304 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
305 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
306 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
307 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
308 Lisp_Object Qultra_expanded
;
309 Lisp_Object Qreleased_button
, Qpressed_button
;
310 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
311 Lisp_Object Qunspecified
;
313 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
315 /* The name of the function to call when the background of the frame
316 has changed, frame_update_face_colors. */
318 Lisp_Object Qframe_update_face_colors
;
320 /* Names of basic faces. */
322 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
323 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
324 extern Lisp_Object Qmode_line
;
326 /* The symbol `face-alias'. A symbols having that property is an
327 alias for another face. Value of the property is the name of
330 Lisp_Object Qface_alias
;
332 /* Names of frame parameters related to faces. */
334 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
335 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
337 /* Default stipple pattern used on monochrome displays. This stipple
338 pattern is used on monochrome displays instead of shades of gray
339 for a face background color. See `set-face-stipple' for possible
340 values for this variable. */
342 Lisp_Object Vface_default_stipple
;
344 /* Alist of alternative font families. Each element is of the form
345 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
346 try FAMILY1, then FAMILY2, ... */
348 Lisp_Object Vface_alternative_font_family_alist
;
350 /* Allowed scalable fonts. A value of nil means don't allow any
351 scalable fonts. A value of t means allow the use of any scalable
352 font. Otherwise, value must be a list of regular expressions. A
353 font may be scaled if its name matches a regular expression in the
357 Lisp_Object Vscalable_fonts_allowed
;
360 /* Maximum number of fonts to consider in font_list. If not an
361 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
363 Lisp_Object Vfont_list_limit
;
364 #define DEFAULT_FONT_LIST_LIMIT 100
366 /* The symbols `foreground-color' and `background-color' which can be
367 used as part of a `face' property. This is for compatibility with
370 Lisp_Object Qforeground_color
, Qbackground_color
;
372 /* The symbols `face' and `mouse-face' used as text properties. */
375 extern Lisp_Object Qmouse_face
;
377 /* Error symbol for wrong_type_argument in load_pixmap. */
379 Lisp_Object Qbitmap_spec_p
;
381 /* Alist of global face definitions. Each element is of the form
382 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
383 is a Lisp vector of face attributes. These faces are used
384 to initialize faces for new frames. */
386 Lisp_Object Vface_new_frame_defaults
;
388 /* The next ID to assign to Lisp faces. */
390 static int next_lface_id
;
392 /* A vector mapping Lisp face Id's to face names. */
394 static Lisp_Object
*lface_id_to_name
;
395 static int lface_id_to_name_size
;
397 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
398 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
400 /* Counter for calls to clear_face_cache. If this counter reaches
401 CLEAR_FONT_TABLE_COUNT, and a frame has more than
402 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
404 static int clear_font_table_count
;
405 #define CLEAR_FONT_TABLE_COUNT 100
406 #define CLEAR_FONT_TABLE_NFONTS 10
408 /* Non-zero means face attributes have been changed since the last
409 redisplay. Used in redisplay_internal. */
411 int face_change_count
;
413 /* The total number of colors currently allocated. */
416 static int ncolors_allocated
;
417 static int npixmaps_allocated
;
423 /* Function prototypes. */
428 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
429 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
430 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
431 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
433 static int first_font_matching
P_ ((struct frame
*f
, char *,
434 struct font_name
*));
435 static int x_face_list_fonts
P_ ((struct frame
*, char *,
436 struct font_name
*, int, int, int));
437 static int font_scalable_p
P_ ((struct font_name
*));
438 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
439 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
440 static unsigned char *xstrlwr
P_ ((unsigned char *));
441 static void signal_error
P_ ((char *, Lisp_Object
));
442 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
443 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
444 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
445 static void free_face_colors
P_ ((struct frame
*, struct face
*));
446 static int face_color_gray_p
P_ ((struct frame
*, char *));
447 static char *build_font_name
P_ ((struct font_name
*));
448 static void free_font_names
P_ ((struct font_name
*, int));
449 static int sorted_font_list
P_ ((struct frame
*, char *,
450 int (*cmpfn
) P_ ((const void *, const void *)),
451 struct font_name
**));
452 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
453 Lisp_Object
, struct font_name
**));
454 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
455 Lisp_Object
, Lisp_Object
, struct font_name
**));
456 static int cmp_font_names
P_ ((const void *, const void *));
457 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
458 struct face
*, int));
459 static struct face
*realize_x_face
P_ ((struct face_cache
*,
460 Lisp_Object
*, int, struct face
*));
461 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
462 Lisp_Object
*, int));
463 static int realize_basic_faces
P_ ((struct frame
*));
464 static int realize_default_face
P_ ((struct frame
*));
465 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
466 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
467 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
468 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
469 static unsigned lface_hash
P_ ((Lisp_Object
*));
470 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
471 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
472 static void free_realized_face
P_ ((struct frame
*, struct face
*));
473 static void clear_face_gcs
P_ ((struct face_cache
*));
474 static void free_face_cache
P_ ((struct face_cache
*));
475 static int face_numeric_weight
P_ ((Lisp_Object
));
476 static int face_numeric_slant
P_ ((Lisp_Object
));
477 static int face_numeric_swidth
P_ ((Lisp_Object
));
478 static int face_fontset
P_ ((Lisp_Object
*));
479 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
480 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
481 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
483 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
484 Lisp_Object
, int, int));
485 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
486 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
487 static void free_realized_faces
P_ ((struct face_cache
*));
488 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
489 struct font_name
*, int));
490 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
491 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
492 static int xlfd_numeric_slant
P_ ((struct font_name
*));
493 static int xlfd_numeric_weight
P_ ((struct font_name
*));
494 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
495 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
496 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
497 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
498 static int xlfd_fixed_p
P_ ((struct font_name
*));
499 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
501 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
502 struct font_name
*, int, int));
503 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
504 struct font_name
*, int));
506 #ifdef HAVE_WINDOW_SYSTEM
508 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
509 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
510 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
511 int (*cmpfn
) P_ ((const void *, const void *))));
512 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
513 static void x_free_gc
P_ ((struct frame
*, GC
));
514 static void clear_font_table
P_ ((struct frame
*));
517 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
518 #endif /* WINDOWSNT */
520 #endif /* HAVE_WINDOW_SYSTEM */
523 /***********************************************************************
525 ***********************************************************************/
527 #ifdef HAVE_X_WINDOWS
529 #ifdef DEBUG_X_COLORS
531 /* The following is a poor mans infrastructure for debugging X color
532 allocation problems on displays with PseudoColor-8. Some X servers
533 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
534 color reference counts completely so that they don't signal an
535 error when a color is freed whose reference count is already 0.
536 Other X servers do. To help me debug this, the following code
537 implements a simple reference counting schema of its own, for a
538 single display/screen. --gerd. */
540 /* Reference counts for pixel colors. */
542 int color_count
[256];
544 /* Register color PIXEL as allocated. */
547 register_color (pixel
)
550 xassert (pixel
< 256);
551 ++color_count
[pixel
];
555 /* Register color PIXEL as deallocated. */
558 unregister_color (pixel
)
561 xassert (pixel
< 256);
562 if (color_count
[pixel
] > 0)
563 --color_count
[pixel
];
569 /* Register N colors from PIXELS as deallocated. */
572 unregister_colors (pixels
, n
)
573 unsigned long *pixels
;
577 for (i
= 0; i
< n
; ++i
)
578 unregister_color (pixels
[i
]);
581 #endif /* DEBUG_X_COLORS */
583 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
584 color values. Interrupt input must be blocked when this function
588 x_free_colors (f
, pixels
, npixels
)
590 unsigned long *pixels
;
593 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
595 /* If display has an immutable color map, freeing colors is not
596 necessary and some servers don't allow it. So don't do it. */
597 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
599 Display
*dpy
= FRAME_X_DISPLAY (f
);
600 Colormap cmap
= FRAME_X_COLORMAP (f
);
601 Screen
*screen
= FRAME_X_SCREEN (f
);
602 int default_cmap_p
= cmap
== DefaultColormapOfScreen (screen
);
606 /* Be paranoid. If using the default color map, don't ever
607 try to free the default black and white colors. */
608 int screen_no
= XScreenNumberOfScreen (screen
);
609 unsigned long black
= BlackPixel (dpy
, screen_no
);
610 unsigned long white
= WhitePixel (dpy
, screen_no
);
614 px
= (unsigned long *) alloca (npixels
* sizeof *px
);
615 for (i
= j
= 0; i
< npixels
; ++i
)
616 if (pixels
[i
] != black
&& pixels
[i
] != white
)
621 XFreeColors (dpy
, cmap
, px
, j
, 0);
622 #ifdef DEBUG_X_COLORS
623 unregister_colors (px
, j
);
629 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
630 #ifdef DEBUG_X_COLORS
631 unregister_colors (pixels
, npixels
);
637 /* Create and return a GC for use on frame F. GC values and mask
638 are given by XGCV and MASK. */
641 x_create_gc (f
, mask
, xgcv
)
648 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
655 /* Free GC which was used on frame F. */
663 xassert (--ngcs
>= 0);
664 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
668 #endif /* HAVE_X_WINDOWS */
671 /* W32 emulation of GCs */
674 x_create_gc (f
, mask
, xgcv
)
681 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
688 /* Free GC which was used on frame F. */
696 xassert (--ngcs
>= 0);
701 #endif /* WINDOWSNT */
703 /* Like stricmp. Used to compare parts of font names which are in
708 unsigned char *s1
, *s2
;
712 unsigned char c1
= tolower (*s1
);
713 unsigned char c2
= tolower (*s2
);
715 return c1
< c2
? -1 : 1;
720 return *s2
== 0 ? 0 : -1;
725 /* Like strlwr, which might not always be available. */
727 static unsigned char *
731 unsigned char *p
= s
;
740 /* Signal `error' with message S, and additional argument ARG. */
743 signal_error (s
, arg
)
747 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
751 /* If FRAME is nil, return a pointer to the selected frame.
752 Otherwise, check that FRAME is a live frame, and return a pointer
753 to it. NPARAM is the parameter number of FRAME, for
754 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
755 Lisp function definitions. */
757 static INLINE
struct frame
*
758 frame_or_selected_frame (frame
, nparam
)
763 frame
= selected_frame
;
765 CHECK_LIVE_FRAME (frame
, nparam
);
766 return XFRAME (frame
);
770 /***********************************************************************
772 ***********************************************************************/
774 /* Initialize face cache and basic faces for frame F. */
780 /* Make a face cache, if F doesn't have one. */
781 if (FRAME_FACE_CACHE (f
) == NULL
)
782 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
784 #ifdef HAVE_WINDOW_SYSTEM
785 /* Make the image cache. */
786 if (FRAME_WINDOW_P (f
))
788 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
789 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
790 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
792 #endif /* HAVE_WINDOW_SYSTEM */
794 /* Realize basic faces. Must have enough information in frame
795 parameters to realize basic faces at this point. */
796 #ifdef HAVE_X_WINDOWS
797 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
800 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
802 if (!realize_basic_faces (f
))
807 /* Free face cache of frame F. Called from Fdelete_frame. */
813 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
817 free_face_cache (face_cache
);
818 FRAME_FACE_CACHE (f
) = NULL
;
821 #ifdef HAVE_WINDOW_SYSTEM
822 if (FRAME_WINDOW_P (f
))
824 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
827 --image_cache
->refcount
;
828 if (image_cache
->refcount
== 0)
829 free_image_cache (f
);
832 #endif /* HAVE_WINDOW_SYSTEM */
836 /* Clear face caches, and recompute basic faces for frame F. Call
837 this after changing frame parameters on which those faces depend,
838 or when realized faces have been freed due to changing attributes
842 recompute_basic_faces (f
)
845 if (FRAME_FACE_CACHE (f
))
847 clear_face_cache (0);
848 if (!realize_basic_faces (f
))
854 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
855 try to free unused fonts, too. */
858 clear_face_cache (clear_fonts_p
)
861 #ifdef HAVE_WINDOW_SYSTEM
862 Lisp_Object tail
, frame
;
866 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
868 /* From time to time see if we can unload some fonts. This also
869 frees all realized faces on all frames. Fonts needed by
870 faces will be loaded again when faces are realized again. */
871 clear_font_table_count
= 0;
873 FOR_EACH_FRAME (tail
, frame
)
876 if (FRAME_WINDOW_P (f
)
877 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
879 free_all_realized_faces (frame
);
880 clear_font_table (f
);
886 /* Clear GCs of realized faces. */
887 FOR_EACH_FRAME (tail
, frame
)
890 if (FRAME_WINDOW_P (f
))
892 clear_face_gcs (FRAME_FACE_CACHE (f
));
893 clear_image_cache (f
, 0);
897 #endif /* HAVE_WINDOW_SYSTEM */
901 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
902 "Clear face caches on all frames.\n\
903 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
905 Lisp_Object thorougly
;
907 clear_face_cache (!NILP (thorougly
));
913 #ifdef HAVE_WINDOW_SYSTEM
916 /* Remove those fonts from the font table of frame F exept for the
917 default ASCII font for the frame. Called from clear_face_cache
918 from time to time. */
924 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
925 Lisp_Object rest
, frame
;
928 xassert (FRAME_WINDOW_P (f
));
930 /* Free those fonts that are not used by the frame F as the default. */
931 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
933 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
936 || font_info
->font
== FRAME_FONT (f
))
940 if (font_info
->full_name
!= font_info
->name
)
941 xfree (font_info
->full_name
);
942 xfree (font_info
->name
);
946 #ifdef HAVE_X_WINDOWS
947 XFreeFont (dpyinfo
->display
, font_info
->font
);
950 w32_unload_font (dpyinfo
, font_info
->font
);
954 /* Mark font table slot free. */
955 font_info
->font
= NULL
;
956 font_info
->name
= font_info
->full_name
= NULL
;
960 #endif /* HAVE_WINDOW_SYSTEM */
964 /***********************************************************************
966 ***********************************************************************/
968 #ifdef HAVE_WINDOW_SYSTEM
970 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
971 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
972 A bitmap specification is either a string, a file name, or a list\n\
973 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
974 HEIGHT is its height, and DATA is a string containing the bits of\n\
975 the pixmap. Bits are stored row by row, each row occupies\n\
976 (WIDTH + 7)/8 bytes.")
982 if (STRINGP (object
))
983 /* If OBJECT is a string, it's a file name. */
985 else if (CONSP (object
))
987 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
988 HEIGHT must be integers > 0, and DATA must be string large
989 enough to hold a bitmap of the specified size. */
990 Lisp_Object width
, height
, data
;
992 height
= width
= data
= Qnil
;
996 width
= XCAR (object
);
997 object
= XCDR (object
);
1000 height
= XCAR (object
);
1001 object
= XCDR (object
);
1003 data
= XCAR (object
);
1007 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1009 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1011 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
1016 return pixmap_p
? Qt
: Qnil
;
1020 /* Load a bitmap according to NAME (which is either a file name or a
1021 pixmap spec) for use on frame F. Value is the bitmap_id (see
1022 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1023 bitmap cannot be loaded, display a message saying so, and return
1024 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1025 if these pointers are not null. */
1028 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1031 unsigned int *w_ptr
, *h_ptr
;
1039 tem
= Fbitmap_spec_p (name
);
1041 wrong_type_argument (Qbitmap_spec_p
, name
);
1046 /* Decode a bitmap spec into a bitmap. */
1051 w
= XINT (Fcar (name
));
1052 h
= XINT (Fcar (Fcdr (name
)));
1053 bits
= Fcar (Fcdr (Fcdr (name
)));
1055 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1060 /* It must be a string -- a file name. */
1061 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1067 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1078 ++npixmaps_allocated
;
1081 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1084 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1090 #endif /* HAVE_WINDOW_SYSTEM */
1094 /***********************************************************************
1096 ***********************************************************************/
1098 #ifdef HAVE_WINDOW_SYSTEM
1100 /* Update the line_height of frame F. Return non-zero if line height
1104 frame_update_line_height (f
)
1107 int line_height
, changed_p
;
1109 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1110 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1111 FRAME_LINE_HEIGHT (f
) = line_height
;
1115 #endif /* HAVE_WINDOW_SYSTEM */
1118 /***********************************************************************
1120 ***********************************************************************/
1122 #ifdef HAVE_WINDOW_SYSTEM
1124 /* Load font of face FACE which is used on frame F to display
1125 character C. The name of the font to load is determined by lface
1126 and fontset of FACE. */
1129 load_face_font (f
, face
, c
)
1134 struct font_info
*font_info
= NULL
;
1137 face
->font_info_id
= -1;
1140 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1145 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1150 face
->font_info_id
= font_info
->font_idx
;
1151 face
->font
= font_info
->font
;
1152 face
->font_name
= font_info
->full_name
;
1155 x_free_gc (f
, face
->gc
);
1160 add_to_log ("Unable to load font %s",
1161 build_string (font_name
), Qnil
);
1165 #endif /* HAVE_WINDOW_SYSTEM */
1169 /***********************************************************************
1171 ***********************************************************************/
1173 /* A version of defined_color for non-X frames. */
1175 tty_defined_color (f
, color_name
, color_def
, alloc
)
1181 Lisp_Object color_desc
;
1182 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
,
1183 red
= 0, green
= 0, blue
= 0;
1186 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1190 XSETFRAME (frame
, f
);
1192 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1193 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1195 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1196 if (CONSP (XCDR (XCDR (color_desc
))))
1198 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1199 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1200 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1204 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1205 /* We were called early during startup, and the colors are not
1206 yet set up in tty-defined-color-alist. Don't return a failure
1207 indication, since this produces the annoying "Unable to
1208 load color" messages in the *Messages* buffer. */
1211 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1213 if (strcmp (color_name
, "unspecified-fg") == 0)
1214 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1215 else if (strcmp (color_name
, "unspecified-bg") == 0)
1216 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1219 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1222 color_def
->pixel
= color_idx
;
1223 color_def
->red
= red
;
1224 color_def
->green
= green
;
1225 color_def
->blue
= blue
;
1230 /* Decide if color named COLOR is valid for the display associated
1231 with the frame F; if so, return the rgb values in COLOR_DEF. If
1232 ALLOC is nonzero, allocate a new colormap cell.
1234 This does the right thing for any type of frame. */
1236 defined_color (f
, color_name
, color_def
, alloc
)
1242 if (!FRAME_WINDOW_P (f
))
1243 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1244 #ifdef HAVE_X_WINDOWS
1245 else if (FRAME_X_P (f
))
1246 return x_defined_color (f
, color_name
, color_def
, alloc
);
1249 else if (FRAME_W32_P (f
))
1250 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1253 else if (FRAME_MAC_P (f
))
1254 /* FIXME: mac_defined_color doesn't exist! */
1255 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1261 /* Given the index of the tty color, return its name, a Lisp string. */
1264 tty_color_name (f
, idx
)
1270 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1273 Lisp_Object coldesc
;
1275 XSETFRAME (frame
, f
);
1276 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1278 if (!NILP (coldesc
))
1279 return XCAR (coldesc
);
1282 /* We can have an MSDOG frame under -nw for a short window of
1283 opportunity before internal_terminal_init is called. DTRT. */
1284 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1285 return msdos_stdcolor_name (idx
);
1288 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1289 return build_string (unspecified_fg
);
1290 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1291 return build_string (unspecified_bg
);
1294 return vga_stdcolor_name (idx
);
1297 return Qunspecified
;
1300 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1301 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1304 face_color_gray_p (f
, color_name
)
1311 if (defined_color (f
, color_name
, &color
, 0))
1312 gray_p
= ((abs (color
.red
- color
.green
)
1313 < max (color
.red
, color
.green
) / 20)
1314 && (abs (color
.green
- color
.blue
)
1315 < max (color
.green
, color
.blue
) / 20)
1316 && (abs (color
.blue
- color
.red
)
1317 < max (color
.blue
, color
.red
) / 20));
1325 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1326 BACKGROUND_P non-zero means the color will be used as background
1330 face_color_supported_p (f
, color_name
, background_p
)
1338 XSETFRAME (frame
, f
);
1339 return (FRAME_WINDOW_P (f
)
1340 ? (!NILP (Fxw_display_color_p (frame
))
1341 || xstricmp (color_name
, "black") == 0
1342 || xstricmp (color_name
, "white") == 0
1344 && face_color_gray_p (f
, color_name
))
1345 || (!NILP (Fx_display_grayscale_p (frame
))
1346 && face_color_gray_p (f
, color_name
)))
1347 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1351 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1352 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1353 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1354 If FRAME is nil or omitted, use the selected frame.")
1356 Lisp_Object color
, frame
;
1360 CHECK_FRAME (frame
, 0);
1361 CHECK_STRING (color
, 0);
1363 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1367 DEFUN ("color-supported-p", Fcolor_supported_p
,
1368 Scolor_supported_p
, 2, 3, 0,
1369 "Return non-nil if COLOR can be displayed on FRAME.\n\
1370 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1371 If FRAME is nil or omitted, use the selected frame.\n\
1372 COLOR must be a valid color name.")
1373 (color
, frame
, background_p
)
1374 Lisp_Object frame
, color
, background_p
;
1378 CHECK_FRAME (frame
, 0);
1379 CHECK_STRING (color
, 0);
1381 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1386 /* Load color with name NAME for use by face FACE on frame F.
1387 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1388 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1389 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1390 pixel color. If color cannot be loaded, display a message, and
1391 return the foreground, background or underline color of F, but
1392 record that fact in flags of the face so that we don't try to free
1396 load_color (f
, face
, name
, target_index
)
1400 enum lface_attribute_index target_index
;
1404 xassert (STRINGP (name
));
1405 xassert (target_index
== LFACE_FOREGROUND_INDEX
1406 || target_index
== LFACE_BACKGROUND_INDEX
1407 || target_index
== LFACE_UNDERLINE_INDEX
1408 || target_index
== LFACE_OVERLINE_INDEX
1409 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1410 || target_index
== LFACE_BOX_INDEX
);
1412 /* if the color map is full, defined_color will return a best match
1413 to the values in an existing cell. */
1414 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1416 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1418 switch (target_index
)
1420 case LFACE_FOREGROUND_INDEX
:
1421 face
->foreground_defaulted_p
= 1;
1422 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1425 case LFACE_BACKGROUND_INDEX
:
1426 face
->background_defaulted_p
= 1;
1427 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1430 case LFACE_UNDERLINE_INDEX
:
1431 face
->underline_defaulted_p
= 1;
1432 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1435 case LFACE_OVERLINE_INDEX
:
1436 face
->overline_color_defaulted_p
= 1;
1437 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1440 case LFACE_STRIKE_THROUGH_INDEX
:
1441 face
->strike_through_color_defaulted_p
= 1;
1442 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1445 case LFACE_BOX_INDEX
:
1446 face
->box_color_defaulted_p
= 1;
1447 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1456 ++ncolors_allocated
;
1462 #ifdef HAVE_WINDOW_SYSTEM
1464 /* Load colors for face FACE which is used on frame F. Colors are
1465 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1466 of ATTRS. If the background color specified is not supported on F,
1467 try to emulate gray colors with a stipple from Vface_default_stipple. */
1470 load_face_colors (f
, face
, attrs
)
1477 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1478 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1480 /* Swap colors if face is inverse-video. */
1481 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1489 /* Check for support for foreground, not for background because
1490 face_color_supported_p is smart enough to know that grays are
1491 "supported" as background because we are supposed to use stipple
1493 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1494 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1496 x_destroy_bitmap (f
, face
->stipple
);
1497 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1498 &face
->pixmap_w
, &face
->pixmap_h
);
1501 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1502 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1506 /* Free color PIXEL on frame F. */
1509 unload_color (f
, pixel
)
1511 unsigned long pixel
;
1513 #ifdef HAVE_X_WINDOWS
1515 x_free_colors (f
, &pixel
, 1);
1521 /* Free colors allocated for FACE. */
1524 free_face_colors (f
, face
)
1528 #ifdef HAVE_X_WINDOWS
1529 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1531 /* If display has an immutable color map, freeing colors is not
1532 necessary and some servers don't allow it. So don't do it. */
1533 if (class != StaticColor
1534 && class != StaticGray
1535 && class != TrueColor
)
1539 if (!face
->foreground_defaulted_p
)
1541 x_free_colors (f
, &face
->foreground
, 1);
1542 IF_DEBUG (--ncolors_allocated
);
1545 if (!face
->background_defaulted_p
)
1547 x_free_colors (f
, &face
->background
, 1);
1548 IF_DEBUG (--ncolors_allocated
);
1551 if (face
->underline_p
1552 && !face
->underline_defaulted_p
)
1554 x_free_colors (f
, &face
->underline_color
, 1);
1555 IF_DEBUG (--ncolors_allocated
);
1558 if (face
->overline_p
1559 && !face
->overline_color_defaulted_p
)
1561 x_free_colors (f
, &face
->overline_color
, 1);
1562 IF_DEBUG (--ncolors_allocated
);
1565 if (face
->strike_through_p
1566 && !face
->strike_through_color_defaulted_p
)
1568 x_free_colors (f
, &face
->strike_through_color
, 1);
1569 IF_DEBUG (--ncolors_allocated
);
1572 if (face
->box
!= FACE_NO_BOX
1573 && !face
->box_color_defaulted_p
)
1575 x_free_colors (f
, &face
->box_color
, 1);
1576 IF_DEBUG (--ncolors_allocated
);
1581 #endif /* HAVE_X_WINDOWS */
1583 #endif /* HAVE_WINDOW_SYSTEM */
1587 /***********************************************************************
1589 ***********************************************************************/
1591 /* An enumerator for each field of an XLFD font name. */
1612 /* An enumerator for each possible slant value of a font. Taken from
1613 the XLFD specification. */
1621 XLFD_SLANT_REVERSE_ITALIC
,
1622 XLFD_SLANT_REVERSE_OBLIQUE
,
1626 /* Relative font weight according to XLFD documentation. */
1630 XLFD_WEIGHT_UNKNOWN
,
1631 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1632 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1633 XLFD_WEIGHT_LIGHT
, /* 30 */
1634 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1635 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1636 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1637 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1638 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1639 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1642 /* Relative proportionate width. */
1646 XLFD_SWIDTH_UNKNOWN
,
1647 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1648 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1649 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1650 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1651 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1652 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1653 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1654 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1655 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1658 /* Structure used for tables mapping XLFD weight, slant, and width
1659 names to numeric and symbolic values. */
1665 Lisp_Object
*symbol
;
1668 /* Table of XLFD slant names and their numeric and symbolic
1669 representations. This table must be sorted by slant names in
1672 static struct table_entry slant_table
[] =
1674 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1675 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1676 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1677 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1678 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1679 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1682 /* Table of XLFD weight names. This table must be sorted by weight
1683 names in ascending order. */
1685 static struct table_entry weight_table
[] =
1687 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1688 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1689 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1690 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1691 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1692 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1693 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1694 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1695 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1696 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1697 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1698 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1699 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1700 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1701 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1704 /* Table of XLFD width names. This table must be sorted by width
1705 names in ascending order. */
1707 static struct table_entry swidth_table
[] =
1709 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1710 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1711 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1712 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1713 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1714 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1715 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1716 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1717 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1718 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1719 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1720 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1721 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1722 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1723 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1726 /* Structure used to hold the result of splitting font names in XLFD
1727 format into their fields. */
1731 /* The original name which is modified destructively by
1732 split_font_name. The pointer is kept here to be able to free it
1733 if it was allocated from the heap. */
1736 /* Font name fields. Each vector element points into `name' above.
1737 Fields are NUL-terminated. */
1738 char *fields
[XLFD_LAST
];
1740 /* Numeric values for those fields that interest us. See
1741 split_font_name for which these are. */
1742 int numeric
[XLFD_LAST
];
1745 /* The frame in effect when sorting font names. Set temporarily in
1746 sort_fonts so that it is available in font comparison functions. */
1748 static struct frame
*font_frame
;
1750 /* Order by which font selection chooses fonts. The default values
1751 mean `first, find a best match for the font width, then for the
1752 font height, then for weight, then for slant.' This variable can be
1753 set via set-face-font-sort-order. */
1755 static int font_sort_order
[4];
1758 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1759 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1760 is a pointer to the matching table entry or null if no table entry
1763 static struct table_entry
*
1764 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1765 struct table_entry
*table
;
1767 struct font_name
*font
;
1770 /* Function split_font_name converts fields to lower-case, so there
1771 is no need to use xstrlwr or xstricmp here. */
1772 char *s
= font
->fields
[field_index
];
1773 int low
, mid
, high
, cmp
;
1780 mid
= (low
+ high
) / 2;
1781 cmp
= strcmp (table
[mid
].name
, s
);
1795 /* Return a numeric representation for font name field
1796 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1797 has DIM entries. Value is the numeric value found or DFLT if no
1798 table entry matches. This function is used to translate weight,
1799 slant, and swidth names of XLFD font names to numeric values. */
1802 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1803 struct table_entry
*table
;
1805 struct font_name
*font
;
1809 struct table_entry
*p
;
1810 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1811 return p
? p
->numeric
: dflt
;
1815 /* Return a symbolic representation for font name field
1816 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1817 has DIM entries. Value is the symbolic value found or DFLT if no
1818 table entry matches. This function is used to translate weight,
1819 slant, and swidth names of XLFD font names to symbols. */
1821 static INLINE Lisp_Object
1822 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1823 struct table_entry
*table
;
1825 struct font_name
*font
;
1829 struct table_entry
*p
;
1830 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1831 return p
? *p
->symbol
: dflt
;
1835 /* Return a numeric value for the slant of the font given by FONT. */
1838 xlfd_numeric_slant (font
)
1839 struct font_name
*font
;
1841 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1842 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1846 /* Return a symbol representing the weight of the font given by FONT. */
1848 static INLINE Lisp_Object
1849 xlfd_symbolic_slant (font
)
1850 struct font_name
*font
;
1852 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1853 font
, XLFD_SLANT
, Qnormal
);
1857 /* Return a numeric value for the weight of the font given by FONT. */
1860 xlfd_numeric_weight (font
)
1861 struct font_name
*font
;
1863 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1864 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1868 /* Return a symbol representing the slant of the font given by FONT. */
1870 static INLINE Lisp_Object
1871 xlfd_symbolic_weight (font
)
1872 struct font_name
*font
;
1874 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1875 font
, XLFD_WEIGHT
, Qnormal
);
1879 /* Return a numeric value for the swidth of the font whose XLFD font
1880 name fields are found in FONT. */
1883 xlfd_numeric_swidth (font
)
1884 struct font_name
*font
;
1886 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1887 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1891 /* Return a symbolic value for the swidth of FONT. */
1893 static INLINE Lisp_Object
1894 xlfd_symbolic_swidth (font
)
1895 struct font_name
*font
;
1897 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1898 font
, XLFD_SWIDTH
, Qnormal
);
1902 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1903 entries. Value is a pointer to the matching table entry or null if
1904 no element of TABLE contains SYMBOL. */
1906 static struct table_entry
*
1907 face_value (table
, dim
, symbol
)
1908 struct table_entry
*table
;
1914 xassert (SYMBOLP (symbol
));
1916 for (i
= 0; i
< dim
; ++i
)
1917 if (EQ (*table
[i
].symbol
, symbol
))
1920 return i
< dim
? table
+ i
: NULL
;
1924 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1925 entries. Value is -1 if SYMBOL is not found in TABLE. */
1928 face_numeric_value (table
, dim
, symbol
)
1929 struct table_entry
*table
;
1933 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1934 return p
? p
->numeric
: -1;
1938 /* Return a numeric value representing the weight specified by Lisp
1939 symbol WEIGHT. Value is one of the enumerators of enum
1943 face_numeric_weight (weight
)
1946 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1950 /* Return a numeric value representing the slant specified by Lisp
1951 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1954 face_numeric_slant (slant
)
1957 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1961 /* Return a numeric value representing the swidth specified by Lisp
1962 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1965 face_numeric_swidth (width
)
1968 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1972 #ifdef HAVE_WINDOW_SYSTEM
1974 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1978 struct font_name
*font
;
1980 /* Function split_font_name converts fields to lower-case, so there
1981 is no need to use tolower here. */
1982 return *font
->fields
[XLFD_SPACING
] != 'p';
1986 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1988 The actual height of the font when displayed on F depends on the
1989 resolution of both the font and frame. For example, a 10pt font
1990 designed for a 100dpi display will display larger than 10pt on a
1991 75dpi display. (It's not unusual to use fonts not designed for the
1992 display one is using. For example, some intlfonts are available in
1993 72dpi versions, only.)
1995 Value is the real point size of FONT on frame F, or 0 if it cannot
1999 xlfd_point_size (f
, font
)
2001 struct font_name
*font
;
2003 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2004 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2005 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2008 if (font_resy
== 0 || font_pt
== 0)
2011 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2017 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2018 of frame F. This function is used to guess a point size of font
2019 when only the pixel height of the font is available. */
2022 pixel_point_size (f
, pixel
)
2026 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2030 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2031 real_pt
= pixel
* 72 / resy
;
2032 int_pt
= real_pt
+ 0.5;
2038 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2039 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2040 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2041 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2042 zero if the font name doesn't have the format we expect. The
2043 expected format is a font name that starts with a `-' and has
2044 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2045 forms of font names where certain field contents are enclosed in
2046 square brackets. We don't support that, for now. */
2049 split_font_name (f
, font
, numeric_p
)
2051 struct font_name
*font
;
2057 if (*font
->name
== '-')
2059 char *p
= xstrlwr (font
->name
) + 1;
2061 while (i
< XLFD_LAST
)
2063 font
->fields
[i
] = p
;
2066 while (*p
&& *p
!= '-')
2076 success_p
= i
== XLFD_LAST
;
2078 /* If requested, and font name was in the expected format,
2079 compute numeric values for some fields. */
2080 if (numeric_p
&& success_p
)
2082 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2083 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2084 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2085 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2086 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2093 /* Build an XLFD font name from font name fields in FONT. Value is a
2094 pointer to the font name, which is allocated via xmalloc. */
2097 build_font_name (font
)
2098 struct font_name
*font
;
2102 char *font_name
= (char *) xmalloc (size
);
2103 int total_length
= 0;
2105 for (i
= 0; i
< XLFD_LAST
; ++i
)
2107 /* Add 1 because of the leading `-'. */
2108 int len
= strlen (font
->fields
[i
]) + 1;
2110 /* Reallocate font_name if necessary. Add 1 for the final
2112 if (total_length
+ len
+ 1 >= size
)
2114 int new_size
= max (2 * size
, size
+ len
+ 1);
2115 int sz
= new_size
* sizeof *font_name
;
2116 font_name
= (char *) xrealloc (font_name
, sz
);
2120 font_name
[total_length
] = '-';
2121 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2122 total_length
+= len
;
2125 font_name
[total_length
] = 0;
2130 /* Free an array FONTS of N font_name structures. This frees FONTS
2131 itself and all `name' fields in its elements. */
2134 free_font_names (fonts
, n
)
2135 struct font_name
*fonts
;
2139 xfree (fonts
[--n
].name
);
2144 /* Sort vector FONTS of font_name structures which contains NFONTS
2145 elements using qsort and comparison function CMPFN. F is the frame
2146 on which the fonts will be used. The global variable font_frame
2147 is temporarily set to F to make it available in CMPFN. */
2150 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2152 struct font_name
*fonts
;
2154 int (*cmpfn
) P_ ((const void *, const void *));
2157 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2162 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2163 display in x_display_list. FONTS is a pointer to a vector of
2164 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2165 alternative patterns from Valternate_fontname_alist if no fonts are
2166 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2169 For all fonts found, set FONTS[i].name to the name of the font,
2170 allocated via xmalloc, and split font names into fields. Ignore
2171 fonts that we can't parse. Value is the number of fonts found.
2173 This is similar to x_list_fonts. The differences are:
2175 1. It avoids consing.
2176 2. It never calls XLoadQueryFont. */
2179 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2183 struct font_name
*fonts
;
2184 int nfonts
, try_alternatives_p
;
2185 int scalable_fonts_p
;
2189 #ifdef HAVE_X_WINDOWS
2190 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2192 /* Get the list of fonts matching PATTERN from the X server. */
2194 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2198 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2199 better to do it the other way around. */
2201 Lisp_Object lpattern
, tem
;
2206 lpattern
= build_string (pattern
);
2208 /* Get the list of fonts matching PATTERN. */
2210 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2213 /* Count fonts returned */
2214 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2217 /* Allocate array. */
2219 names
= (char **) xmalloc (n
* sizeof (char *));
2221 /* Extract font names into char * array. */
2223 for (i
= 0; i
< n
; i
++)
2225 names
[i
] = XSTRING (XCAR (tem
))->data
;
2232 /* Make a copy of the font names we got from X, and
2233 split them into fields. */
2234 for (i
= j
= 0; i
< n
; ++i
)
2236 /* Make a copy of the font name. */
2237 fonts
[j
].name
= xstrdup (names
[i
]);
2239 /* Ignore fonts having a name that we can't parse. */
2240 if (!split_font_name (f
, fonts
+ j
, 1))
2241 xfree (fonts
[j
].name
);
2242 else if (font_scalable_p (fonts
+ j
))
2245 if (!scalable_fonts_p
2246 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2247 xfree (fonts
[j
].name
);
2250 #else /* !SCALABLE_FONTS */
2251 /* Always ignore scalable fonts. */
2252 xfree (fonts
[j
].name
);
2253 #endif /* !SCALABLE_FONTS */
2261 #ifdef HAVE_X_WINDOWS
2262 /* Free font names. */
2264 XFreeFontNames (names
);
2270 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2271 if (n
== 0 && try_alternatives_p
)
2273 Lisp_Object list
= Valternate_fontname_alist
;
2275 while (CONSP (list
))
2277 Lisp_Object entry
= XCAR (list
);
2279 && STRINGP (XCAR (entry
))
2280 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2287 Lisp_Object patterns
= XCAR (list
);
2290 while (CONSP (patterns
)
2291 /* If list is screwed up, give up. */
2292 && (name
= XCAR (patterns
),
2294 /* Ignore patterns equal to PATTERN because we tried that
2295 already with no success. */
2296 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2297 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2301 patterns
= XCDR (patterns
);
2309 /* Determine the first font matching PATTERN on frame F. Return in
2310 *FONT the matching font name, split into fields. Value is non-zero
2311 if a match was found. */
2314 first_font_matching (f
, pattern
, font
)
2317 struct font_name
*font
;
2320 struct font_name
*fonts
;
2322 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2323 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2327 bcopy (&fonts
[0], font
, sizeof *font
);
2329 fonts
[0].name
= NULL
;
2330 free_font_names (fonts
, nfonts
);
2337 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2338 using comparison function CMPFN. Value is the number of fonts
2339 found. If value is non-zero, *FONTS is set to a vector of
2340 font_name structures allocated from the heap containing matching
2341 fonts. Each element of *FONTS contains a name member that is also
2342 allocated from the heap. Font names in these structures are split
2343 into fields. Use free_font_names to free such an array. */
2346 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2349 int (*cmpfn
) P_ ((const void *, const void *));
2350 struct font_name
**fonts
;
2354 /* Get the list of fonts matching pattern. 100 should suffice. */
2355 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2356 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2357 nfonts
= XFASTINT (Vfont_list_limit
);
2359 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2361 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2363 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2366 /* Sort the resulting array and return it in *FONTS. If no
2367 fonts were found, make sure to set *FONTS to null. */
2369 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2380 /* Compare two font_name structures *A and *B. Value is analogous to
2381 strcmp. Sort order is given by the global variable
2382 font_sort_order. Font names are sorted so that, everything else
2383 being equal, fonts with a resolution closer to that of the frame on
2384 which they are used are listed first. The global variable
2385 font_frame is the frame on which we operate. */
2388 cmp_font_names (a
, b
)
2391 struct font_name
*x
= (struct font_name
*) a
;
2392 struct font_name
*y
= (struct font_name
*) b
;
2395 /* All strings have been converted to lower-case by split_font_name,
2396 so we can use strcmp here. */
2397 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2402 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2404 int j
= font_sort_order
[i
];
2405 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2410 /* Everything else being equal, we prefer fonts with an
2411 y-resolution closer to that of the frame. */
2412 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2413 int x_resy
= x
->numeric
[XLFD_RESY
];
2414 int y_resy
= y
->numeric
[XLFD_RESY
];
2415 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2423 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2424 is non-nil list fonts matching that pattern. Otherwise, if
2425 REGISTRY is non-nil return only fonts with that registry, otherwise
2426 return fonts of any registry. Set *FONTS to a vector of font_name
2427 structures allocated from the heap containing the fonts found.
2428 Value is the number of fonts found. */
2431 font_list (f
, pattern
, family
, registry
, fonts
)
2433 Lisp_Object pattern
, family
, registry
;
2434 struct font_name
**fonts
;
2436 char *pattern_str
, *family_str
, *registry_str
;
2440 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2441 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2443 pattern_str
= (char *) alloca (strlen (family_str
)
2444 + strlen (registry_str
)
2446 if (index (family_str
, '-'))
2447 sprintf (pattern_str
, "-%s-*-%s", family_str
, registry_str
);
2449 sprintf (pattern_str
, "-*-%s-*-%s", family_str
, registry_str
);
2452 pattern_str
= (char *) XSTRING (pattern
)->data
;
2454 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2458 /* Remove elements from LIST whose cars are `equal'. Called from
2459 x-family-fonts and x-font-family-list to remove duplicate font
2463 remove_duplicates (list
)
2466 Lisp_Object tail
= list
;
2468 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2470 Lisp_Object next
= XCDR (tail
);
2471 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2472 XCDR (tail
) = XCDR (next
);
2479 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2480 "Return a list of available fonts of family FAMILY on FRAME.\n\
2481 If FAMILY is omitted or nil, list all families.\n\
2482 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2484 If FRAME is omitted or nil, use the selected frame.\n\
2485 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2486 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2487 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2488 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2489 width, weight and slant of the font. These symbols are the same as for\n\
2490 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2491 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2492 giving the registry and encoding of the font.\n\
2493 The result list is sorted according to the current setting of\n\
2494 the face font sort order.")
2496 Lisp_Object family
, frame
;
2498 struct frame
*f
= check_x_frame (frame
);
2499 struct font_name
*fonts
;
2502 struct gcpro gcpro1
;
2505 CHECK_STRING (family
, 1);
2509 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2510 for (i
= nfonts
- 1; i
>= 0; --i
)
2512 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2515 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2517 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2518 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2519 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2520 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2521 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2522 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2523 tem
= build_font_name (fonts
+ i
);
2524 ASET (v
, 6, build_string (tem
));
2525 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2526 fonts
[i
].fields
[XLFD_ENCODING
]);
2527 ASET (v
, 7, build_string (tem
));
2530 result
= Fcons (v
, result
);
2535 remove_duplicates (result
);
2536 free_font_names (fonts
, nfonts
);
2542 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2544 "Return a list of available font families on FRAME.\n\
2545 If FRAME is omitted or nil, use the selected frame.\n\
2546 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2547 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2552 struct frame
*f
= check_x_frame (frame
);
2554 struct font_name
*fonts
;
2556 struct gcpro gcpro1
;
2557 int count
= specpdl_ptr
- specpdl
;
2560 /* Let's consider all fonts. Increase the limit for matching
2561 fonts until we have them all. */
2564 specbind (intern ("font-list-limit"), make_number (limit
));
2565 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2567 if (nfonts
== limit
)
2569 free_font_names (fonts
, nfonts
);
2578 for (i
= nfonts
- 1; i
>= 0; --i
)
2579 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2580 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2583 remove_duplicates (result
);
2584 free_font_names (fonts
, nfonts
);
2586 return unbind_to (count
, result
);
2590 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2591 "Return a list of the names of available fonts matching PATTERN.\n\
2592 If optional arguments FACE and FRAME are specified, return only fonts\n\
2593 the same size as FACE on FRAME.\n\
2594 PATTERN is a string, perhaps with wildcard characters;\n\
2595 the * character matches any substring, and\n\
2596 the ? character matches any single character.\n\
2597 PATTERN is case-insensitive.\n\
2598 FACE is a face name--a symbol.\n\
2600 The return value is a list of strings, suitable as arguments to\n\
2603 Fonts Emacs can't use may or may not be excluded\n\
2604 even if they match PATTERN and FACE.\n\
2605 The optional fourth argument MAXIMUM sets a limit on how many\n\
2606 fonts to match. The first MAXIMUM fonts are reported.\n\
2607 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2608 occupied by a character of a font. In that case, return only fonts\n\
2609 the WIDTH times as wide as FACE on FRAME.")
2610 (pattern
, face
, frame
, maximum
, width
)
2611 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2618 CHECK_STRING (pattern
, 0);
2624 CHECK_NATNUM (maximum
, 0);
2625 maxnames
= XINT (maximum
);
2629 CHECK_NUMBER (width
, 4);
2631 /* We can't simply call check_x_frame because this function may be
2632 called before any frame is created. */
2633 f
= frame_or_selected_frame (frame
, 2);
2634 if (!FRAME_WINDOW_P (f
))
2636 /* Perhaps we have not yet created any frame. */
2641 /* Determine the width standard for comparison with the fonts we find. */
2647 /* This is of limited utility since it works with character
2648 widths. Keep it for compatibility. --gerd. */
2649 int face_id
= lookup_named_face (f
, face
, 0);
2650 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2653 size
= FONT_WIDTH (face
->font
);
2655 size
= FONT_WIDTH (FRAME_FONT (f
));
2658 size
*= XINT (width
);
2662 Lisp_Object args
[2];
2664 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2666 /* We don't have to check fontsets. */
2668 args
[1] = list_fontsets (f
, pattern
, size
);
2669 return Fnconc (2, args
);
2673 #endif /* HAVE_WINDOW_SYSTEM */
2677 /***********************************************************************
2679 ***********************************************************************/
2681 /* Access face attributes of face FACE, a Lisp vector. */
2683 #define LFACE_FAMILY(LFACE) \
2684 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2685 #define LFACE_HEIGHT(LFACE) \
2686 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2687 #define LFACE_WEIGHT(LFACE) \
2688 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2689 #define LFACE_SLANT(LFACE) \
2690 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2691 #define LFACE_UNDERLINE(LFACE) \
2692 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2693 #define LFACE_INVERSE(LFACE) \
2694 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2695 #define LFACE_FOREGROUND(LFACE) \
2696 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2697 #define LFACE_BACKGROUND(LFACE) \
2698 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2699 #define LFACE_STIPPLE(LFACE) \
2700 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2701 #define LFACE_SWIDTH(LFACE) \
2702 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2703 #define LFACE_OVERLINE(LFACE) \
2704 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2705 #define LFACE_STRIKE_THROUGH(LFACE) \
2706 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2707 #define LFACE_BOX(LFACE) \
2708 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2709 #define LFACE_FONT(LFACE) \
2710 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2712 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2713 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2715 #define LFACEP(LFACE) \
2717 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2718 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2723 /* Check consistency of Lisp face attribute vector ATTRS. */
2726 check_lface_attrs (attrs
)
2729 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2730 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2731 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2732 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2733 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2734 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2735 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2736 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2737 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2738 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2739 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2740 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2741 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2742 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2743 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2744 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2745 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2746 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2747 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2748 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2749 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2750 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2751 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2752 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2753 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2754 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2755 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2756 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2757 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2758 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2759 #ifdef HAVE_WINDOW_SYSTEM
2760 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2761 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2762 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2763 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2764 || NILP (attrs
[LFACE_FONT_INDEX
])
2765 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2770 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2778 xassert (LFACEP (lface
));
2779 check_lface_attrs (XVECTOR (lface
)->contents
);
2783 #else /* GLYPH_DEBUG == 0 */
2785 #define check_lface_attrs(attrs) (void) 0
2786 #define check_lface(lface) (void) 0
2788 #endif /* GLYPH_DEBUG == 0 */
2791 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2792 to make it a symvol. If FACE_NAME is an alias for another face,
2793 return that face's name. */
2796 resolve_face_name (face_name
)
2797 Lisp_Object face_name
;
2799 Lisp_Object aliased
;
2801 if (STRINGP (face_name
))
2802 face_name
= intern (XSTRING (face_name
)->data
);
2806 aliased
= Fget (face_name
, Qface_alias
);
2810 face_name
= aliased
;
2817 /* Return the face definition of FACE_NAME on frame F. F null means
2818 return the global definition. FACE_NAME may be a string or a
2819 symbol (apparently Emacs 20.2 allows strings as face names in face
2820 text properties; ediff uses that). If FACE_NAME is an alias for
2821 another face, return that face's definition. If SIGNAL_P is
2822 non-zero, signal an error if FACE_NAME is not a valid face name.
2823 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2826 static INLINE Lisp_Object
2827 lface_from_face_name (f
, face_name
, signal_p
)
2829 Lisp_Object face_name
;
2834 face_name
= resolve_face_name (face_name
);
2837 lface
= assq_no_quit (face_name
, f
->face_alist
);
2839 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2842 lface
= XCDR (lface
);
2844 signal_error ("Invalid face", face_name
);
2846 check_lface (lface
);
2851 /* Get face attributes of face FACE_NAME from frame-local faces on
2852 frame F. Store the resulting attributes in ATTRS which must point
2853 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2854 is non-zero, signal an error if FACE_NAME does not name a face.
2855 Otherwise, value is zero if FACE_NAME is not a face. */
2858 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2860 Lisp_Object face_name
;
2867 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2870 bcopy (XVECTOR (lface
)->contents
, attrs
,
2871 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2881 /* Non-zero if all attributes in face attribute vector ATTRS are
2882 specified, i.e. are non-nil. */
2885 lface_fully_specified_p (attrs
)
2890 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2891 if (UNSPECIFIEDP (attrs
[i
]) && i
!= LFACE_FONT_INDEX
)
2894 return i
== LFACE_VECTOR_SIZE
;
2897 #ifdef HAVE_WINDOW_SYSTEM
2899 /* Set font-related attributes of Lisp face LFACE from the fullname of
2900 the font opened by FONTNAME. If FORCE_P is zero, set only
2901 unspecified attributes of LFACE. The exception is `font'
2902 attribute. It is set to FONTNAME as is regardless of FORCE_P.
2904 If FONTNAME is not available on frame F,
2905 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
2906 If the fullname is not in a valid XLFD format,
2907 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
2908 in LFACE and return 1.
2909 Otherwise, return 1. */
2912 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
2915 Lisp_Object fontname
;
2916 int force_p
, may_fail_p
;
2918 struct font_name font
;
2923 char *font_name
= XSTRING (fontname
)->data
;
2924 struct font_info
*font_info
;
2926 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
2927 fontset
= fs_query_fontset (fontname
, 0);
2929 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
2931 /* Check if FONT_NAME is surely available on the system. Usually
2932 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
2933 returns quickly. But, even if FONT_NAME is not yet cached,
2934 caching it now is not futail because we anyway load the font
2937 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
2947 font
.name
= STRDUPA (font_info
->full_name
);
2948 have_xlfd_p
= split_font_name (f
, &font
, 1);
2950 /* Set attributes only if unspecified, otherwise face defaults for
2951 new frames would never take effect. If we couldn't get a font
2952 name conforming to XLFD, set normal values. */
2954 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2959 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2960 + strlen (font
.fields
[XLFD_FOUNDRY
])
2962 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2963 font
.fields
[XLFD_FAMILY
]);
2964 val
= build_string (buffer
);
2967 val
= build_string ("*");
2968 LFACE_FAMILY (lface
) = val
;
2971 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2974 pt
= xlfd_point_size (f
, &font
);
2976 pt
= pixel_point_size (f
, font_info
->height
* 10);
2978 LFACE_HEIGHT (lface
) = make_number (pt
);
2981 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2982 LFACE_SWIDTH (lface
)
2983 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
2985 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2986 LFACE_WEIGHT (lface
)
2987 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
2989 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2991 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
2993 LFACE_FONT (lface
) = fontname
;
2997 #endif /* HAVE_WINDOW_SYSTEM */
3000 /* Merge two Lisp face attribute vectors FROM and TO and store the
3001 resulting attributes in TO. Every non-nil attribute of FROM
3002 overrides the corresponding attribute of TO. */
3005 merge_face_vectors (from
, to
)
3006 Lisp_Object
*from
, *to
;
3009 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3010 if (!UNSPECIFIEDP (from
[i
]))
3015 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3016 is a face property, determine the resulting face attributes on
3017 frame F, and store them in TO. PROP may be a single face
3018 specification or a list of such specifications. Each face
3019 specification can be
3021 1. A symbol or string naming a Lisp face.
3023 2. A property list of the form (KEYWORD VALUE ...) where each
3024 KEYWORD is a face attribute name, and value is an appropriate value
3027 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3028 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3029 for compatibility with 20.2.
3031 Face specifications earlier in lists take precedence over later
3035 merge_face_vector_with_property (f
, to
, prop
)
3042 Lisp_Object first
= XCAR (prop
);
3044 if (EQ (first
, Qforeground_color
)
3045 || EQ (first
, Qbackground_color
))
3047 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3048 . COLOR). COLOR must be a string. */
3049 Lisp_Object color_name
= XCDR (prop
);
3050 Lisp_Object color
= first
;
3052 if (STRINGP (color_name
))
3054 if (EQ (color
, Qforeground_color
))
3055 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3057 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3060 add_to_log ("Invalid face color", color_name
, Qnil
);
3062 else if (SYMBOLP (first
)
3063 && *XSYMBOL (first
)->name
->data
== ':')
3065 /* Assume this is the property list form. */
3066 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3068 Lisp_Object keyword
= XCAR (prop
);
3069 Lisp_Object value
= XCAR (XCDR (prop
));
3071 if (EQ (keyword
, QCfamily
))
3073 if (STRINGP (value
))
3074 to
[LFACE_FAMILY_INDEX
] = value
;
3076 add_to_log ("Illegal face font family", value
, Qnil
);
3078 else if (EQ (keyword
, QCheight
))
3080 if (INTEGERP (value
))
3081 to
[LFACE_HEIGHT_INDEX
] = value
;
3083 add_to_log ("Illegal face font height", value
, Qnil
);
3085 else if (EQ (keyword
, QCweight
))
3088 && face_numeric_weight (value
) >= 0)
3089 to
[LFACE_WEIGHT_INDEX
] = value
;
3091 add_to_log ("Illegal face weight", value
, Qnil
);
3093 else if (EQ (keyword
, QCslant
))
3096 && face_numeric_slant (value
) >= 0)
3097 to
[LFACE_SLANT_INDEX
] = value
;
3099 add_to_log ("Illegal face slant", value
, Qnil
);
3101 else if (EQ (keyword
, QCunderline
))
3106 to
[LFACE_UNDERLINE_INDEX
] = value
;
3108 add_to_log ("Illegal face underline", value
, Qnil
);
3110 else if (EQ (keyword
, QCoverline
))
3115 to
[LFACE_OVERLINE_INDEX
] = value
;
3117 add_to_log ("Illegal face overline", value
, Qnil
);
3119 else if (EQ (keyword
, QCstrike_through
))
3124 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3126 add_to_log ("Illegal face strike-through", value
, Qnil
);
3128 else if (EQ (keyword
, QCbox
))
3131 value
= make_number (1);
3132 if (INTEGERP (value
)
3136 to
[LFACE_BOX_INDEX
] = value
;
3138 add_to_log ("Illegal face box", value
, Qnil
);
3140 else if (EQ (keyword
, QCinverse_video
)
3141 || EQ (keyword
, QCreverse_video
))
3143 if (EQ (value
, Qt
) || NILP (value
))
3144 to
[LFACE_INVERSE_INDEX
] = value
;
3146 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3148 else if (EQ (keyword
, QCforeground
))
3150 if (STRINGP (value
))
3151 to
[LFACE_FOREGROUND_INDEX
] = value
;
3153 add_to_log ("Illegal face foreground", value
, Qnil
);
3155 else if (EQ (keyword
, QCbackground
))
3157 if (STRINGP (value
))
3158 to
[LFACE_BACKGROUND_INDEX
] = value
;
3160 add_to_log ("Illegal face background", value
, Qnil
);
3162 else if (EQ (keyword
, QCstipple
))
3164 #ifdef HAVE_X_WINDOWS
3165 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3166 if (!NILP (pixmap_p
))
3167 to
[LFACE_STIPPLE_INDEX
] = value
;
3169 add_to_log ("Illegal face stipple", value
, Qnil
);
3172 else if (EQ (keyword
, QCwidth
))
3175 && face_numeric_swidth (value
) >= 0)
3176 to
[LFACE_SWIDTH_INDEX
] = value
;
3178 add_to_log ("Illegal face width", value
, Qnil
);
3181 add_to_log ("Invalid attribute %s in face property",
3184 prop
= XCDR (XCDR (prop
));
3189 /* This is a list of face specs. Specifications at the
3190 beginning of the list take precedence over later
3191 specifications, so we have to merge starting with the
3192 last specification. */
3193 Lisp_Object next
= XCDR (prop
);
3195 merge_face_vector_with_property (f
, to
, next
);
3196 merge_face_vector_with_property (f
, to
, first
);
3201 /* PROP ought to be a face name. */
3202 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3204 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3206 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3211 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3212 Sinternal_make_lisp_face
, 1, 2, 0,
3213 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3214 If FACE was not known as a face before, create a new one.\n\
3215 If optional argument FRAME is specified, make a frame-local face\n\
3216 for that frame. Otherwise operate on the global face definition.\n\
3217 Value is a vector of face attributes.")
3219 Lisp_Object face
, frame
;
3221 Lisp_Object global_lface
, lface
;
3225 CHECK_SYMBOL (face
, 0);
3226 global_lface
= lface_from_face_name (NULL
, face
, 0);
3230 CHECK_LIVE_FRAME (frame
, 1);
3232 lface
= lface_from_face_name (f
, face
, 0);
3235 f
= NULL
, lface
= Qnil
;
3237 /* Add a global definition if there is none. */
3238 if (NILP (global_lface
))
3240 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3242 XVECTOR (global_lface
)->contents
[0] = Qface
;
3243 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3244 Vface_new_frame_defaults
);
3246 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3247 face id to Lisp face is given by the vector lface_id_to_name.
3248 The mapping from Lisp face to Lisp face id is given by the
3249 property `face' of the Lisp face name. */
3250 if (next_lface_id
== lface_id_to_name_size
)
3252 int new_size
= max (50, 2 * lface_id_to_name_size
);
3253 int sz
= new_size
* sizeof *lface_id_to_name
;
3254 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3255 lface_id_to_name_size
= new_size
;
3258 lface_id_to_name
[next_lface_id
] = face
;
3259 Fput (face
, Qface
, make_number (next_lface_id
));
3263 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3264 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3266 /* Add a frame-local definition. */
3271 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3273 XVECTOR (lface
)->contents
[0] = Qface
;
3274 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3277 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3278 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3281 lface
= global_lface
;
3283 xassert (LFACEP (lface
));
3284 check_lface (lface
);
3289 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3290 Sinternal_lisp_face_p
, 1, 2, 0,
3291 "Return non-nil if FACE names a face.\n\
3292 If optional second parameter FRAME is non-nil, check for the\n\
3293 existence of a frame-local face with name FACE on that frame.\n\
3294 Otherwise check for the existence of a global face.")
3296 Lisp_Object face
, frame
;
3302 CHECK_LIVE_FRAME (frame
, 1);
3303 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3306 lface
= lface_from_face_name (NULL
, face
, 0);
3312 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3313 Sinternal_copy_lisp_face
, 4, 4, 0,
3314 "Copy face FROM to TO.\n\
3315 If FRAME it t, copy the global face definition of FROM to the\n\
3316 global face definition of TO. Otherwise, copy the frame-local\n\
3317 definition of FROM on FRAME to the frame-local definition of TO\n\
3318 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3321 (from
, to
, frame
, new_frame
)
3322 Lisp_Object from
, to
, frame
, new_frame
;
3324 Lisp_Object lface
, copy
;
3326 CHECK_SYMBOL (from
, 0);
3327 CHECK_SYMBOL (to
, 1);
3328 if (NILP (new_frame
))
3333 /* Copy global definition of FROM. We don't make copies of
3334 strings etc. because 20.2 didn't do it either. */
3335 lface
= lface_from_face_name (NULL
, from
, 1);
3336 copy
= Finternal_make_lisp_face (to
, Qnil
);
3340 /* Copy frame-local definition of FROM. */
3341 CHECK_LIVE_FRAME (frame
, 2);
3342 CHECK_LIVE_FRAME (new_frame
, 3);
3343 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3344 copy
= Finternal_make_lisp_face (to
, new_frame
);
3347 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3348 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3354 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3355 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3356 "Set attribute ATTR of FACE to VALUE.\n\
3357 If optional argument FRAME is given, set the face attribute of face FACE\n\
3358 on that frame. If FRAME is t, set the attribute of the default for face\n\
3359 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3361 (face
, attr
, value
, frame
)
3362 Lisp_Object face
, attr
, value
, frame
;
3365 Lisp_Object old_value
= Qnil
;
3366 /* Set 1 if ATTR is QCfont. */
3367 int font_attr_p
= 0;
3368 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3369 int font_related_attr_p
= 0;
3371 CHECK_SYMBOL (face
, 0);
3372 CHECK_SYMBOL (attr
, 1);
3374 face
= resolve_face_name (face
);
3376 /* Set lface to the Lisp attribute vector of FACE. */
3378 lface
= lface_from_face_name (NULL
, face
, 1);
3382 frame
= selected_frame
;
3384 CHECK_LIVE_FRAME (frame
, 3);
3385 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3387 /* If a frame-local face doesn't exist yet, create one. */
3389 lface
= Finternal_make_lisp_face (face
, frame
);
3392 if (EQ (attr
, QCfamily
))
3394 if (!UNSPECIFIEDP (value
))
3396 CHECK_STRING (value
, 3);
3397 if (XSTRING (value
)->size
== 0)
3398 signal_error ("Invalid face family", value
);
3400 old_value
= LFACE_FAMILY (lface
);
3401 LFACE_FAMILY (lface
) = value
;
3402 font_related_attr_p
= 1;
3404 else if (EQ (attr
, QCheight
))
3406 if (!UNSPECIFIEDP (value
))
3408 CHECK_NUMBER (value
, 3);
3409 if (XINT (value
) <= 0)
3410 signal_error ("Invalid face height", value
);
3412 old_value
= LFACE_HEIGHT (lface
);
3413 LFACE_HEIGHT (lface
) = value
;
3414 font_related_attr_p
= 1;
3416 else if (EQ (attr
, QCweight
))
3418 if (!UNSPECIFIEDP (value
))
3420 CHECK_SYMBOL (value
, 3);
3421 if (face_numeric_weight (value
) < 0)
3422 signal_error ("Invalid face weight", value
);
3424 old_value
= LFACE_WEIGHT (lface
);
3425 LFACE_WEIGHT (lface
) = value
;
3426 font_related_attr_p
= 1;
3428 else if (EQ (attr
, QCslant
))
3430 if (!UNSPECIFIEDP (value
))
3432 CHECK_SYMBOL (value
, 3);
3433 if (face_numeric_slant (value
) < 0)
3434 signal_error ("Invalid face slant", value
);
3436 old_value
= LFACE_SLANT (lface
);
3437 LFACE_SLANT (lface
) = value
;
3438 font_related_attr_p
= 1;
3440 else if (EQ (attr
, QCunderline
))
3442 if (!UNSPECIFIEDP (value
))
3443 if ((SYMBOLP (value
)
3445 && !EQ (value
, Qnil
))
3446 /* Underline color. */
3448 && XSTRING (value
)->size
== 0))
3449 signal_error ("Invalid face underline", value
);
3451 old_value
= LFACE_UNDERLINE (lface
);
3452 LFACE_UNDERLINE (lface
) = value
;
3454 else if (EQ (attr
, QCoverline
))
3456 if (!UNSPECIFIEDP (value
))
3457 if ((SYMBOLP (value
)
3459 && !EQ (value
, Qnil
))
3460 /* Overline color. */
3462 && XSTRING (value
)->size
== 0))
3463 signal_error ("Invalid face overline", value
);
3465 old_value
= LFACE_OVERLINE (lface
);
3466 LFACE_OVERLINE (lface
) = value
;
3468 else if (EQ (attr
, QCstrike_through
))
3470 if (!UNSPECIFIEDP (value
))
3471 if ((SYMBOLP (value
)
3473 && !EQ (value
, Qnil
))
3474 /* Strike-through color. */
3476 && XSTRING (value
)->size
== 0))
3477 signal_error ("Invalid face strike-through", value
);
3479 old_value
= LFACE_STRIKE_THROUGH (lface
);
3480 LFACE_STRIKE_THROUGH (lface
) = value
;
3482 else if (EQ (attr
, QCbox
))
3486 /* Allow t meaning a simple box of width 1 in foreground color
3489 value
= make_number (1);
3491 if (UNSPECIFIEDP (value
))
3493 else if (NILP (value
))
3495 else if (INTEGERP (value
))
3496 valid_p
= XINT (value
) > 0;
3497 else if (STRINGP (value
))
3498 valid_p
= XSTRING (value
)->size
> 0;
3499 else if (CONSP (value
))
3515 if (EQ (k
, QCline_width
))
3517 if (!INTEGERP (v
) || XINT (v
) <= 0)
3520 else if (EQ (k
, QCcolor
))
3522 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3525 else if (EQ (k
, QCstyle
))
3527 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3534 valid_p
= NILP (tem
);
3540 signal_error ("Invalid face box", value
);
3542 old_value
= LFACE_BOX (lface
);
3543 LFACE_BOX (lface
) = value
;
3545 else if (EQ (attr
, QCinverse_video
)
3546 || EQ (attr
, QCreverse_video
))
3548 if (!UNSPECIFIEDP (value
))
3550 CHECK_SYMBOL (value
, 3);
3551 if (!EQ (value
, Qt
) && !NILP (value
))
3552 signal_error ("Invalid inverse-video face attribute value", value
);
3554 old_value
= LFACE_INVERSE (lface
);
3555 LFACE_INVERSE (lface
) = value
;
3557 else if (EQ (attr
, QCforeground
))
3559 if (!UNSPECIFIEDP (value
))
3561 /* Don't check for valid color names here because it depends
3562 on the frame (display) whether the color will be valid
3563 when the face is realized. */
3564 CHECK_STRING (value
, 3);
3565 if (XSTRING (value
)->size
== 0)
3566 signal_error ("Empty foreground color value", value
);
3568 old_value
= LFACE_FOREGROUND (lface
);
3569 LFACE_FOREGROUND (lface
) = value
;
3571 else if (EQ (attr
, QCbackground
))
3573 if (!UNSPECIFIEDP (value
))
3575 /* Don't check for valid color names here because it depends
3576 on the frame (display) whether the color will be valid
3577 when the face is realized. */
3578 CHECK_STRING (value
, 3);
3579 if (XSTRING (value
)->size
== 0)
3580 signal_error ("Empty background color value", value
);
3582 old_value
= LFACE_BACKGROUND (lface
);
3583 LFACE_BACKGROUND (lface
) = value
;
3585 else if (EQ (attr
, QCstipple
))
3587 #ifdef HAVE_X_WINDOWS
3588 if (!UNSPECIFIEDP (value
)
3590 && NILP (Fbitmap_spec_p (value
)))
3591 signal_error ("Invalid stipple attribute", value
);
3592 old_value
= LFACE_STIPPLE (lface
);
3593 LFACE_STIPPLE (lface
) = value
;
3594 #endif /* HAVE_X_WINDOWS */
3596 else if (EQ (attr
, QCwidth
))
3598 if (!UNSPECIFIEDP (value
))
3600 CHECK_SYMBOL (value
, 3);
3601 if (face_numeric_swidth (value
) < 0)
3602 signal_error ("Invalid face width", value
);
3604 old_value
= LFACE_SWIDTH (lface
);
3605 LFACE_SWIDTH (lface
) = value
;
3606 font_related_attr_p
= 1;
3608 else if (EQ (attr
, QCfont
))
3610 #ifdef HAVE_WINDOW_SYSTEM
3611 /* Set font-related attributes of the Lisp face from an
3616 CHECK_STRING (value
, 3);
3618 f
= SELECTED_FRAME ();
3620 f
= check_x_frame (frame
);
3622 /* VALUE may be a fontset name or an alias of fontset. In such
3623 a case, use the base fontset name. */
3624 tmp
= Fquery_fontset (value
, Qnil
);
3628 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3629 signal_error ("Invalid font or fontset name", value
);
3632 #endif /* HAVE_WINDOW_SYSTEM */
3634 else if (EQ (attr
, QCbold
))
3636 old_value
= LFACE_WEIGHT (lface
);
3637 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3638 font_related_attr_p
= 1;
3640 else if (EQ (attr
, QCitalic
))
3642 old_value
= LFACE_SLANT (lface
);
3643 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3644 font_related_attr_p
= 1;
3647 signal_error ("Invalid face attribute name", attr
);
3649 if (font_related_attr_p
3650 && !UNSPECIFIEDP (value
))
3651 /* If a font-related attribute other than QCfont is specified, the
3652 original `font' attribute nor that of default face is useless
3653 to determine a new font. Thus, we set it to nil so that font
3654 selection mechanism doesn't use it. */
3655 LFACE_FONT (lface
) = Qnil
;
3657 /* Changing a named face means that all realized faces depending on
3658 that face are invalid. Since we cannot tell which realized faces
3659 depend on the face, make sure they are all removed. This is done
3660 by incrementing face_change_count. The next call to
3661 init_iterator will then free realized faces. */
3663 && (EQ (attr
, QCfont
)
3664 || NILP (Fequal (old_value
, value
))))
3666 ++face_change_count
;
3667 ++windows_or_buffers_changed
;
3670 #ifdef HAVE_WINDOW_SYSTEM
3673 && !UNSPECIFIEDP (value
)
3674 && NILP (Fequal (old_value
, value
)))
3680 if (EQ (face
, Qdefault
))
3682 /* Changed font-related attributes of the `default' face are
3683 reflected in changed `font' frame parameters. */
3684 if ((font_related_attr_p
|| font_attr_p
)
3685 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3686 set_font_frame_param (frame
, lface
);
3687 else if (EQ (attr
, QCforeground
))
3688 param
= Qforeground_color
;
3689 else if (EQ (attr
, QCbackground
))
3690 param
= Qbackground_color
;
3693 else if (EQ (face
, Qscroll_bar
))
3695 /* Changing the colors of `scroll-bar' sets frame parameters
3696 `scroll-bar-foreground' and `scroll-bar-background'. */
3697 if (EQ (attr
, QCforeground
))
3698 param
= Qscroll_bar_foreground
;
3699 else if (EQ (attr
, QCbackground
))
3700 param
= Qscroll_bar_background
;
3703 else if (EQ (face
, Qborder
))
3705 /* Changing background color of `border' sets frame parameter
3707 if (EQ (attr
, QCbackground
))
3708 param
= Qborder_color
;
3710 else if (EQ (face
, Qcursor
))
3712 /* Changing background color of `cursor' sets frame parameter
3714 if (EQ (attr
, QCbackground
))
3715 param
= Qcursor_color
;
3717 else if (EQ (face
, Qmouse
))
3719 /* Changing background color of `mouse' sets frame parameter
3721 if (EQ (attr
, QCbackground
))
3722 param
= Qmouse_color
;
3726 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3729 #endif /* HAVE_WINDOW_SYSTEM */
3735 #ifdef HAVE_WINDOW_SYSTEM
3737 /* Set the `font' frame parameter of FRAME determined from `default'
3738 face attributes LFACE. If a face or fontset name is explicitely
3739 specfied in LFACE, use it as is. Otherwise, determine a font name
3740 from the other font-related atrributes of LFACE. In that case, if
3741 there's no matching font, signals an error. */
3744 set_font_frame_param (frame
, lface
)
3745 Lisp_Object frame
, lface
;
3747 struct frame
*f
= XFRAME (frame
);
3748 Lisp_Object font_name
;
3751 if (STRINGP (LFACE_FONT (lface
)))
3752 font_name
= LFACE_FONT (lface
);
3755 /* Choose a font name that reflects LFACE's attributes and has
3756 the registry and encoding pattern specified in the default
3757 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
3758 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
3760 error ("No font matches the specified attribute");
3761 font_name
= build_string (font
);
3764 store_frame_param (f
, Qfont
, font_name
);
3768 /* Update the corresponding face when frame parameter PARAM on frame F
3769 has been assigned the value NEW_VALUE. */
3772 update_face_from_frame_parameter (f
, param
, new_value
)
3774 Lisp_Object param
, new_value
;
3778 /* If there are no faces yet, give up. This is the case when called
3779 from Fx_create_frame, and we do the necessary things later in
3780 face-set-after-frame-defaults. */
3781 if (NILP (f
->face_alist
))
3784 if (EQ (param
, Qforeground_color
))
3786 lface
= lface_from_face_name (f
, Qdefault
, 1);
3787 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3788 ? new_value
: Qunspecified
);
3789 realize_basic_faces (f
);
3791 else if (EQ (param
, Qbackground_color
))
3795 /* Changing the background color might change the background
3796 mode, so that we have to load new defface specs. Call
3797 frame-update-face-colors to do that. */
3798 XSETFRAME (frame
, f
);
3799 call1 (Qframe_update_face_colors
, frame
);
3801 lface
= lface_from_face_name (f
, Qdefault
, 1);
3802 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3803 ? new_value
: Qunspecified
);
3804 realize_basic_faces (f
);
3806 if (EQ (param
, Qborder_color
))
3808 lface
= lface_from_face_name (f
, Qborder
, 1);
3809 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3810 ? new_value
: Qunspecified
);
3812 else if (EQ (param
, Qcursor_color
))
3814 lface
= lface_from_face_name (f
, Qcursor
, 1);
3815 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3816 ? new_value
: Qunspecified
);
3818 else if (EQ (param
, Qmouse_color
))
3820 lface
= lface_from_face_name (f
, Qmouse
, 1);
3821 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3822 ? new_value
: Qunspecified
);
3827 /* Get the value of X resource RESOURCE, class CLASS for the display
3828 of frame FRAME. This is here because ordinary `x-get-resource'
3829 doesn't take a frame argument. */
3831 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3832 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3833 (resource
, class, frame
)
3834 Lisp_Object resource
, class, frame
;
3836 Lisp_Object value
= Qnil
;
3838 CHECK_STRING (resource
, 0);
3839 CHECK_STRING (class, 1);
3840 CHECK_LIVE_FRAME (frame
, 2);
3842 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3843 resource
, class, Qnil
, Qnil
);
3850 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3851 If VALUE is "on" or "true", return t. If VALUE is "off" or
3852 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3853 error; if SIGNAL_P is zero, return 0. */
3856 face_boolean_x_resource_value (value
, signal_p
)
3860 Lisp_Object result
= make_number (0);
3862 xassert (STRINGP (value
));
3864 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3865 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3867 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3868 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3870 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3871 result
= Qunspecified
;
3873 signal_error ("Invalid face attribute value from X resource", value
);
3879 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3880 Finternal_set_lisp_face_attribute_from_resource
,
3881 Sinternal_set_lisp_face_attribute_from_resource
,
3883 (face
, attr
, value
, frame
)
3884 Lisp_Object face
, attr
, value
, frame
;
3886 CHECK_SYMBOL (face
, 0);
3887 CHECK_SYMBOL (attr
, 1);
3888 CHECK_STRING (value
, 2);
3890 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3891 value
= Qunspecified
;
3892 else if (EQ (attr
, QCheight
))
3894 value
= Fstring_to_number (value
, make_number (10));
3895 if (XINT (value
) <= 0)
3896 signal_error ("Invalid face height from X resource", value
);
3898 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3899 value
= face_boolean_x_resource_value (value
, 1);
3900 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3901 value
= intern (XSTRING (value
)->data
);
3902 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3903 value
= face_boolean_x_resource_value (value
, 1);
3904 else if (EQ (attr
, QCunderline
)
3905 || EQ (attr
, QCoverline
)
3906 || EQ (attr
, QCstrike_through
)
3907 || EQ (attr
, QCbox
))
3909 Lisp_Object boolean_value
;
3911 /* If the result of face_boolean_x_resource_value is t or nil,
3912 VALUE does NOT specify a color. */
3913 boolean_value
= face_boolean_x_resource_value (value
, 0);
3914 if (SYMBOLP (boolean_value
))
3915 value
= boolean_value
;
3918 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3921 #endif /* HAVE_WINDOW_SYSTEM */
3924 #ifdef HAVE_X_WINDOWS
3925 /***********************************************************************
3927 ***********************************************************************/
3929 #ifdef USE_X_TOOLKIT
3931 /* Structure used to pass X resources to functions called via
3932 XtApplyToWidgets. */
3943 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3944 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3947 /* Set widget W's X resources from P which points to an x_resources
3948 structure. If W is a cascade button, apply resources to W's
3952 xm_apply_resources (w
, p
)
3957 struct x_resources
*res
= (struct x_resources
*) p
;
3959 XtSetValues (w
, res
->av
, res
->ac
);
3960 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3963 XtSetValues (submenu
, res
->av
, res
->ac
);
3964 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3969 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3970 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3973 1. Setting the XmNfontList resource leads to an infinite loop
3974 somewhere in LessTif. */
3977 xm_set_menu_resources_from_menu_face (f
, widget
)
3987 lface
= lface_from_face_name (f
, Qmenu
, 1);
3988 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3990 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3992 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3996 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3998 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4002 /* If any font-related attribute of `menu' is set, set the font. */
4004 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4005 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4006 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4007 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4008 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4010 #if 0 /* Setting the font leads to an infinite loop somewhere
4011 in LessTif during geometry computation. */
4013 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4014 fl
= XmFontListAppendEntry (NULL
, fe
);
4015 XtSetArg (av
[ac
], XmNfontList
, fl
);
4020 xassert (ac
<= sizeof av
/ sizeof *av
);
4024 struct x_resources res
;
4026 XtSetValues (widget
, av
, ac
);
4027 res
.av
= av
, res
.ac
= ac
;
4028 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4030 XmFontListFree (fl
);
4035 #endif /* USE_MOTIF */
4039 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4040 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4043 /* Set widget W's resources from P which points to an x_resources
4047 xl_apply_resources (widget
, p
)
4051 struct x_resources
*res
= (struct x_resources
*) p
;
4052 XtSetValues (widget
, res
->av
, res
->ac
);
4056 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4057 This is the Lucid version. */
4060 xl_set_menu_resources_from_menu_face (f
, widget
)
4069 lface
= lface_from_face_name (f
, Qmenu
, 1);
4070 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4072 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4074 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4078 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4080 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4085 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4086 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4087 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4088 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4089 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4091 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4097 struct x_resources res
;
4099 XtSetValues (widget
, av
, ac
);
4101 /* We must do children here in case we're handling a pop-up menu
4102 in which case WIDGET is a popup shell. XtApplyToWidgets
4103 is a function from lwlib. */
4104 res
.av
= av
, res
.ac
= ac
;
4105 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4109 #endif /* USE_LUCID */
4112 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4115 x_set_menu_resources_from_menu_face (f
, widget
)
4119 /* Realized faces may have been removed on frame F, e.g. because of
4120 face attribute changes. Recompute them, if necessary, since we
4121 will need the `menu' face. */
4122 if (f
->face_cache
->used
== 0)
4123 recompute_basic_faces (f
);
4126 xl_set_menu_resources_from_menu_face (f
, widget
);
4129 xm_set_menu_resources_from_menu_face (f
, widget
);
4133 #endif /* USE_X_TOOLKIT */
4135 #endif /* HAVE_X_WINDOWS */
4139 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4140 Sinternal_get_lisp_face_attribute
,
4142 "Return face attribute KEYWORD of face SYMBOL.\n\
4143 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4144 face attribute name, signal an error.\n\
4145 If the optional argument FRAME is given, report on face FACE in that\n\
4146 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4147 frames). If FRAME is omitted or nil, use the selected frame.")
4148 (symbol
, keyword
, frame
)
4149 Lisp_Object symbol
, keyword
, frame
;
4151 Lisp_Object lface
, value
= Qnil
;
4153 CHECK_SYMBOL (symbol
, 0);
4154 CHECK_SYMBOL (keyword
, 1);
4157 lface
= lface_from_face_name (NULL
, symbol
, 1);
4161 frame
= selected_frame
;
4162 CHECK_LIVE_FRAME (frame
, 2);
4163 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4166 if (EQ (keyword
, QCfamily
))
4167 value
= LFACE_FAMILY (lface
);
4168 else if (EQ (keyword
, QCheight
))
4169 value
= LFACE_HEIGHT (lface
);
4170 else if (EQ (keyword
, QCweight
))
4171 value
= LFACE_WEIGHT (lface
);
4172 else if (EQ (keyword
, QCslant
))
4173 value
= LFACE_SLANT (lface
);
4174 else if (EQ (keyword
, QCunderline
))
4175 value
= LFACE_UNDERLINE (lface
);
4176 else if (EQ (keyword
, QCoverline
))
4177 value
= LFACE_OVERLINE (lface
);
4178 else if (EQ (keyword
, QCstrike_through
))
4179 value
= LFACE_STRIKE_THROUGH (lface
);
4180 else if (EQ (keyword
, QCbox
))
4181 value
= LFACE_BOX (lface
);
4182 else if (EQ (keyword
, QCinverse_video
)
4183 || EQ (keyword
, QCreverse_video
))
4184 value
= LFACE_INVERSE (lface
);
4185 else if (EQ (keyword
, QCforeground
))
4186 value
= LFACE_FOREGROUND (lface
);
4187 else if (EQ (keyword
, QCbackground
))
4188 value
= LFACE_BACKGROUND (lface
);
4189 else if (EQ (keyword
, QCstipple
))
4190 value
= LFACE_STIPPLE (lface
);
4191 else if (EQ (keyword
, QCwidth
))
4192 value
= LFACE_SWIDTH (lface
);
4193 else if (EQ (keyword
, QCfont
))
4194 value
= LFACE_FONT (lface
);
4196 signal_error ("Invalid face attribute name", keyword
);
4202 DEFUN ("internal-lisp-face-attribute-values",
4203 Finternal_lisp_face_attribute_values
,
4204 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4205 "Return a list of valid discrete values for face attribute ATTR.\n\
4206 Value is nil if ATTR doesn't have a discrete set of valid values.")
4210 Lisp_Object result
= Qnil
;
4212 CHECK_SYMBOL (attr
, 0);
4214 if (EQ (attr
, QCweight
)
4215 || EQ (attr
, QCslant
)
4216 || EQ (attr
, QCwidth
))
4218 /* Extract permissible symbols from tables. */
4219 struct table_entry
*table
;
4222 if (EQ (attr
, QCweight
))
4223 table
= weight_table
, dim
= DIM (weight_table
);
4224 else if (EQ (attr
, QCslant
))
4225 table
= slant_table
, dim
= DIM (slant_table
);
4227 table
= swidth_table
, dim
= DIM (swidth_table
);
4229 for (i
= 0; i
< dim
; ++i
)
4231 Lisp_Object symbol
= *table
[i
].symbol
;
4232 Lisp_Object tail
= result
;
4235 && !EQ (XCAR (tail
), symbol
))
4239 result
= Fcons (symbol
, result
);
4242 else if (EQ (attr
, QCunderline
))
4243 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4244 else if (EQ (attr
, QCoverline
))
4245 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4246 else if (EQ (attr
, QCstrike_through
))
4247 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4248 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4249 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4255 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4256 Sinternal_merge_in_global_face
, 2, 2, 0,
4257 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4259 Lisp_Object face
, frame
;
4261 Lisp_Object global_lface
, local_lface
;
4262 CHECK_LIVE_FRAME (frame
, 1);
4263 global_lface
= lface_from_face_name (NULL
, face
, 1);
4264 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4265 if (NILP (local_lface
))
4266 local_lface
= Finternal_make_lisp_face (face
, frame
);
4267 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4268 XVECTOR (local_lface
)->contents
);
4273 /* The following function is implemented for compatibility with 20.2.
4274 The function is used in x-resolve-fonts when it is asked to
4275 return fonts with the same size as the font of a face. This is
4276 done in fontset.el. */
4278 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4279 "Return the font name of face FACE, or nil if it is unspecified.\n\
4280 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4281 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4282 The font default for a face is either nil, or a list\n\
4283 of the form (bold), (italic) or (bold italic).\n\
4284 If FRAME is omitted or nil, use the selected frame.")
4286 Lisp_Object face
, frame
;
4290 Lisp_Object result
= Qnil
;
4291 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4293 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4294 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4295 result
= Fcons (Qbold
, result
);
4297 if (!NILP (LFACE_SLANT (lface
))
4298 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4299 result
= Fcons (Qitalic
, result
);
4305 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4306 int face_id
= lookup_named_face (f
, face
, 0);
4307 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4308 return build_string (face
->font_name
);
4313 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4314 all attributes are `equal'. Tries to be fast because this function
4315 is called quite often. */
4318 lface_equal_p (v1
, v2
)
4319 Lisp_Object
*v1
, *v2
;
4323 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4325 Lisp_Object a
= v1
[i
];
4326 Lisp_Object b
= v2
[i
];
4328 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4329 and the other is specified. */
4330 equal_p
= XTYPE (a
) == XTYPE (b
);
4339 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4340 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4341 XSTRING (a
)->size
) == 0);
4350 equal_p
= !NILP (Fequal (a
, b
));
4360 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4361 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4362 "True if FACE1 and FACE2 are equal.\n\
4363 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4364 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4365 If FRAME is omitted or nil, use the selected frame.")
4366 (face1
, face2
, frame
)
4367 Lisp_Object face1
, face2
, frame
;
4371 Lisp_Object lface1
, lface2
;
4376 /* Don't use check_x_frame here because this function is called
4377 before X frames exist. At that time, if FRAME is nil,
4378 selected_frame will be used which is the frame dumped with
4379 Emacs. That frame is not an X frame. */
4380 f
= frame_or_selected_frame (frame
, 2);
4382 lface1
= lface_from_face_name (NULL
, face1
, 1);
4383 lface2
= lface_from_face_name (NULL
, face2
, 1);
4384 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4385 XVECTOR (lface2
)->contents
);
4386 return equal_p
? Qt
: Qnil
;
4390 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4391 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4392 "True if FACE has no attribute specified.\n\
4393 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4394 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4395 If FRAME is omitted or nil, use the selected frame.")
4397 Lisp_Object face
, frame
;
4404 frame
= selected_frame
;
4405 CHECK_LIVE_FRAME (frame
, 0);
4409 lface
= lface_from_face_name (NULL
, face
, 1);
4411 lface
= lface_from_face_name (f
, face
, 1);
4413 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4414 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4417 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4421 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4423 "Return an alist of frame-local faces defined on FRAME.\n\
4424 For internal use only.")
4428 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4429 return f
->face_alist
;
4433 /* Return a hash code for Lisp string STRING with case ignored. Used
4434 below in computing a hash value for a Lisp face. */
4436 static INLINE
unsigned
4437 hash_string_case_insensitive (string
)
4442 xassert (STRINGP (string
));
4443 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4444 hash
= (hash
<< 1) ^ tolower (*s
);
4449 /* Return a hash code for face attribute vector V. */
4451 static INLINE
unsigned
4455 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4456 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4457 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4458 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4459 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4460 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4461 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4465 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4466 considering charsets/registries). They do if they specify the same
4467 family, point size, weight, width, slant, and fontset. Both LFACE1
4468 and LFACE2 must be fully-specified. */
4471 lface_same_font_attributes_p (lface1
, lface2
)
4472 Lisp_Object
*lface1
, *lface2
;
4474 xassert (lface_fully_specified_p (lface1
)
4475 && lface_fully_specified_p (lface2
));
4476 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4477 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4478 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4479 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4480 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4481 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4482 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4483 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4484 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4485 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4486 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4487 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4492 /***********************************************************************
4494 ***********************************************************************/
4496 /* Allocate and return a new realized face for Lisp face attribute
4499 static struct face
*
4500 make_realized_face (attr
)
4503 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4504 bzero (face
, sizeof *face
);
4505 face
->ascii_face
= face
;
4506 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4511 /* Free realized face FACE, including its X resources. FACE may
4515 free_realized_face (f
, face
)
4521 #ifdef HAVE_WINDOW_SYSTEM
4522 if (FRAME_WINDOW_P (f
))
4524 /* Free fontset of FACE if it is ASCII face. */
4525 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4526 free_face_fontset (f
, face
);
4529 x_free_gc (f
, face
->gc
);
4533 free_face_colors (f
, face
);
4534 x_destroy_bitmap (f
, face
->stipple
);
4536 #endif /* HAVE_WINDOW_SYSTEM */
4543 /* Prepare face FACE for subsequent display on frame F. This
4544 allocated GCs if they haven't been allocated yet or have been freed
4545 by clearing the face cache. */
4548 prepare_face_for_display (f
, face
)
4552 #ifdef HAVE_WINDOW_SYSTEM
4553 xassert (FRAME_WINDOW_P (f
));
4558 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4560 xgcv
.foreground
= face
->foreground
;
4561 xgcv
.background
= face
->background
;
4562 #ifdef HAVE_X_WINDOWS
4563 xgcv
.graphics_exposures
= False
;
4565 /* The font of FACE may be null if we couldn't load it. */
4568 #ifdef HAVE_X_WINDOWS
4569 xgcv
.font
= face
->font
->fid
;
4572 xgcv
.font
= face
->font
;
4578 #ifdef HAVE_X_WINDOWS
4581 xgcv
.fill_style
= FillOpaqueStippled
;
4582 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4583 mask
|= GCFillStyle
| GCStipple
;
4586 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4589 #endif /* HAVE_WINDOW_SYSTEM */
4593 /***********************************************************************
4595 ***********************************************************************/
4597 /* Return a new face cache for frame F. */
4599 static struct face_cache
*
4603 struct face_cache
*c
;
4606 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4607 bzero (c
, sizeof *c
);
4608 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4609 c
->buckets
= (struct face
**) xmalloc (size
);
4610 bzero (c
->buckets
, size
);
4612 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4618 /* Clear out all graphics contexts for all realized faces, except for
4619 the basic faces. This should be done from time to time just to avoid
4620 keeping too many graphics contexts that are no longer needed. */
4624 struct face_cache
*c
;
4626 if (c
&& FRAME_WINDOW_P (c
->f
))
4628 #ifdef HAVE_WINDOW_SYSTEM
4630 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4632 struct face
*face
= c
->faces_by_id
[i
];
4633 if (face
&& face
->gc
)
4635 x_free_gc (c
->f
, face
->gc
);
4639 #endif /* HAVE_WINDOW_SYSTEM */
4644 /* Free all realized faces in face cache C, including basic faces. C
4645 may be null. If faces are freed, make sure the frame's current
4646 matrix is marked invalid, so that a display caused by an expose
4647 event doesn't try to use faces we destroyed. */
4650 free_realized_faces (c
)
4651 struct face_cache
*c
;
4656 struct frame
*f
= c
->f
;
4658 for (i
= 0; i
< c
->used
; ++i
)
4660 free_realized_face (f
, c
->faces_by_id
[i
]);
4661 c
->faces_by_id
[i
] = NULL
;
4665 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4666 bzero (c
->buckets
, size
);
4668 /* Must do a thorough redisplay the next time. Mark current
4669 matrices as invalid because they will reference faces freed
4670 above. This function is also called when a frame is
4671 destroyed. In this case, the root window of F is nil. */
4672 if (WINDOWP (f
->root_window
))
4674 clear_current_matrices (f
);
4675 ++windows_or_buffers_changed
;
4681 /* Free all faces realized for multibyte characters on frame F that
4685 free_realized_multibyte_face (f
, fontset
)
4689 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4693 for (i
= 0; i
< cache
->used
; i
++)
4695 face
= cache
->faces_by_id
[i
];
4697 && face
!= face
->ascii_face
4698 && face
->fontset
== fontset
)
4700 uncache_face (cache
, face
);
4701 free_realized_face (f
, face
);
4704 if (WINDOWP (f
->root_window
))
4706 clear_current_matrices (f
);
4707 ++windows_or_buffers_changed
;
4712 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4713 This is done after attributes of a named face have been changed,
4714 because we can't tell which realized faces depend on that face. */
4717 free_all_realized_faces (frame
)
4723 FOR_EACH_FRAME (rest
, frame
)
4724 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4727 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4731 /* Free face cache C and faces in it, including their X resources. */
4735 struct face_cache
*c
;
4739 free_realized_faces (c
);
4741 xfree (c
->faces_by_id
);
4747 /* Cache realized face FACE in face cache C. HASH is the hash value
4748 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4749 collision list of the face hash table of C. This is done because
4750 otherwise lookup_face would find FACE for every character, even if
4751 faces with the same attributes but for specific characters exist. */
4754 cache_face (c
, face
, hash
)
4755 struct face_cache
*c
;
4759 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4763 if (face
->fontset
>= 0)
4765 struct face
*last
= c
->buckets
[i
];
4776 c
->buckets
[i
] = face
;
4777 face
->prev
= face
->next
= NULL
;
4783 face
->next
= c
->buckets
[i
];
4785 face
->next
->prev
= face
;
4786 c
->buckets
[i
] = face
;
4789 /* Find a free slot in C->faces_by_id and use the index of the free
4790 slot as FACE->id. */
4791 for (i
= 0; i
< c
->used
; ++i
)
4792 if (c
->faces_by_id
[i
] == NULL
)
4796 /* Maybe enlarge C->faces_by_id. */
4797 if (i
== c
->used
&& c
->used
== c
->size
)
4799 int new_size
= 2 * c
->size
;
4800 int sz
= new_size
* sizeof *c
->faces_by_id
;
4801 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4806 /* Check that FACE got a unique id. */
4811 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4812 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4818 #endif /* GLYPH_DEBUG */
4820 c
->faces_by_id
[i
] = face
;
4826 /* Remove face FACE from cache C. */
4829 uncache_face (c
, face
)
4830 struct face_cache
*c
;
4833 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4836 face
->prev
->next
= face
->next
;
4838 c
->buckets
[i
] = face
->next
;
4841 face
->next
->prev
= face
->prev
;
4843 c
->faces_by_id
[face
->id
] = NULL
;
4844 if (face
->id
== c
->used
)
4849 /* Look up a realized face with face attributes ATTR in the face cache
4850 of frame F. The face will be used to display character C. Value
4851 is the ID of the face found. If no suitable face is found, realize
4852 a new one. In that case, if C is a multibyte character, BASE_FACE
4853 is a face for ASCII characters that has the same attributes. */
4856 lookup_face (f
, attr
, c
, base_face
)
4860 struct face
*base_face
;
4862 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4867 xassert (cache
!= NULL
);
4868 check_lface_attrs (attr
);
4870 /* Look up ATTR in the face cache. */
4871 hash
= lface_hash (attr
);
4872 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4874 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4875 if (face
->hash
== hash
4876 && (!FRAME_WINDOW_P (f
)
4877 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
4878 && lface_equal_p (face
->lface
, attr
))
4881 /* If not found, realize a new face. */
4883 face
= realize_face (cache
, attr
, c
, base_face
, -1);
4886 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4888 /* When this function is called from face_for_char (in this case, C is
4889 a multibyte character), a fontset of a face returned by
4890 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
4891 C) is not sutisfied. The fontset is set for this face by
4892 face_for_char later. */
4894 if (FRAME_WINDOW_P (f
))
4895 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
4897 #endif /* GLYPH_DEBUG */
4903 /* Return the face id of the realized face for named face SYMBOL on
4904 frame F suitable for displaying character C. */
4907 lookup_named_face (f
, symbol
, c
)
4912 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4913 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4914 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4916 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4917 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4918 merge_face_vectors (symbol_attrs
, attrs
);
4919 return lookup_face (f
, attrs
, c
, NULL
);
4923 /* Return the ID of the realized ASCII face of Lisp face with ID
4924 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4927 ascii_face_of_lisp_face (f
, lface_id
)
4933 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4935 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4936 face_id
= lookup_named_face (f
, face_name
, 0);
4945 /* Return a face for charset ASCII that is like the face with id
4946 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4947 STEPS < 0 means larger. Value is the id of the face. */
4950 smaller_face (f
, face_id
, steps
)
4954 #ifdef HAVE_WINDOW_SYSTEM
4956 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4957 int pt
, last_pt
, last_height
;
4960 struct face
*new_face
;
4962 /* If not called for an X frame, just return the original face. */
4963 if (FRAME_TERMCAP_P (f
))
4966 /* Try in increments of 1/2 pt. */
4967 delta
= steps
< 0 ? 5 : -5;
4968 steps
= abs (steps
);
4970 face
= FACE_FROM_ID (f
, face_id
);
4971 bcopy (face
->lface
, attrs
, sizeof attrs
);
4972 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4973 new_face_id
= face_id
;
4974 last_height
= FONT_HEIGHT (face
->font
);
4978 /* Give up if we cannot find a font within 10pt. */
4979 && abs (last_pt
- pt
) < 100)
4981 /* Look up a face for a slightly smaller/larger font. */
4983 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4984 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
4985 new_face
= FACE_FROM_ID (f
, new_face_id
);
4987 /* If height changes, count that as one step. */
4988 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4991 last_height
= FONT_HEIGHT (new_face
->font
);
4998 #else /* not HAVE_WINDOW_SYSTEM */
5002 #endif /* not HAVE_WINDOW_SYSTEM */
5006 /* Return a face for charset ASCII that is like the face with id
5007 FACE_ID on frame F, but has height HEIGHT. */
5010 face_with_height (f
, face_id
, height
)
5015 #ifdef HAVE_WINDOW_SYSTEM
5017 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5019 if (FRAME_TERMCAP_P (f
)
5023 face
= FACE_FROM_ID (f
, face_id
);
5024 bcopy (face
->lface
, attrs
, sizeof attrs
);
5025 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5026 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5027 #endif /* HAVE_WINDOW_SYSTEM */
5032 /* Return the face id of the realized face for named face SYMBOL on
5033 frame F suitable for displaying character C, and use attributes of
5034 the face FACE_ID for attributes that aren't completely specified by
5035 SYMBOL. This is like lookup_named_face, except that the default
5036 attributes come from FACE_ID, not from the default face. FACE_ID
5037 is assumed to be already realized. */
5040 lookup_derived_face (f
, symbol
, c
, face_id
)
5046 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5047 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5048 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5053 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5054 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5055 merge_face_vectors (symbol_attrs
, attrs
);
5056 return lookup_face (f
, attrs
, c
, default_face
);
5061 /***********************************************************************
5063 ***********************************************************************/
5065 DEFUN ("internal-set-font-selection-order",
5066 Finternal_set_font_selection_order
,
5067 Sinternal_set_font_selection_order
, 1, 1, 0,
5068 "Set font selection order for face font selection to ORDER.\n\
5069 ORDER must be a list of length 4 containing the symbols `:width',\n\
5070 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5071 first in ORDER are matched first, e.g. if `:height' appears before\n\
5072 `:weight' in ORDER, font selection first tries to find a font with\n\
5073 a suitable height, and then tries to match the font weight.\n\
5082 CHECK_LIST (order
, 0);
5083 bzero (indices
, sizeof indices
);
5087 CONSP (list
) && i
< DIM (indices
);
5088 list
= XCDR (list
), ++i
)
5090 Lisp_Object attr
= XCAR (list
);
5093 if (EQ (attr
, QCwidth
))
5095 else if (EQ (attr
, QCheight
))
5096 xlfd
= XLFD_POINT_SIZE
;
5097 else if (EQ (attr
, QCweight
))
5099 else if (EQ (attr
, QCslant
))
5104 if (indices
[i
] != 0)
5110 || i
!= DIM (indices
)
5115 signal_error ("Invalid font sort order", order
);
5117 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5119 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5120 free_all_realized_faces (Qnil
);
5127 DEFUN ("internal-set-alternative-font-family-alist",
5128 Finternal_set_alternative_font_family_alist
,
5129 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5130 "Define alternative font families to try in face font selection.\n\
5131 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5132 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5133 be found. Value is ALIST.")
5137 CHECK_LIST (alist
, 0);
5138 Vface_alternative_font_family_alist
= alist
;
5139 free_all_realized_faces (Qnil
);
5144 #ifdef HAVE_WINDOW_SYSTEM
5146 /* Value is non-zero if FONT is the name of a scalable font. The
5147 X11R6 XLFD spec says that point size, pixel size, and average width
5148 are zero for scalable fonts. Intlfonts contain at least one
5149 scalable font ("*-muleindian-1") for which this isn't true, so we
5150 just test average width. */
5153 font_scalable_p (font
)
5154 struct font_name
*font
;
5156 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5157 return (*s
== '0' && *(s
+ 1) == '\0')
5159 /* Windows implementation of XLFD is slightly broken for backward
5160 compatibility with previous broken versions, so test for
5161 wildcards as well as 0. */
5168 /* Value is non-zero if FONT1 is a better match for font attributes
5169 VALUES than FONT2. VALUES is an array of face attribute values in
5170 font sort order. COMPARE_PT_P zero means don't compare point
5174 better_font_p (values
, font1
, font2
, compare_pt_p
)
5176 struct font_name
*font1
, *font2
;
5181 for (i
= 0; i
< 4; ++i
)
5183 int xlfd_idx
= font_sort_order
[i
];
5185 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5187 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5188 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5190 if (delta1
> delta2
)
5192 else if (delta1
< delta2
)
5196 /* The difference may be equal because, e.g., the face
5197 specifies `italic' but we have only `regular' and
5198 `oblique'. Prefer `oblique' in this case. */
5199 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5200 && font1
->numeric
[xlfd_idx
] > values
[i
]
5201 && font2
->numeric
[xlfd_idx
] < values
[i
])
5213 /* Value is non-zero if FONT is an exact match for face attributes in
5214 SPECIFIED. SPECIFIED is an array of face attribute values in font
5218 exact_face_match_p (specified
, font
)
5220 struct font_name
*font
;
5224 for (i
= 0; i
< 4; ++i
)
5225 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5232 /* Value is the name of a scaled font, generated from scalable font
5233 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5234 Value is allocated from heap. */
5237 build_scalable_font_name (f
, font
, specified_pt
)
5239 struct font_name
*font
;
5242 char point_size
[20], pixel_size
[20];
5244 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5247 /* If scalable font is for a specific resolution, compute
5248 the point size we must specify from the resolution of
5249 the display and the specified resolution of the font. */
5250 if (font
->numeric
[XLFD_RESY
] != 0)
5252 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5253 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5258 pixel_value
= resy
/ 720.0 * pt
;
5261 /* Set point size of the font. */
5262 sprintf (point_size
, "%d", (int) pt
);
5263 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5264 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5266 /* Set pixel size. */
5267 sprintf (pixel_size
, "%d", pixel_value
);
5268 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5269 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5271 /* If font doesn't specify its resolution, use the
5272 resolution of the display. */
5273 if (font
->numeric
[XLFD_RESY
] == 0)
5276 sprintf (buffer
, "%d", (int) resy
);
5277 font
->fields
[XLFD_RESY
] = buffer
;
5278 font
->numeric
[XLFD_RESY
] = resy
;
5281 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5284 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5285 sprintf (buffer
, "%d", resx
);
5286 font
->fields
[XLFD_RESX
] = buffer
;
5287 font
->numeric
[XLFD_RESX
] = resx
;
5290 return build_font_name (font
);
5294 /* Value is non-zero if we are allowed to use scalable font FONT. We
5295 can't run a Lisp function here since this function may be called
5296 with input blocked. */
5299 may_use_scalable_font_p (font
, name
)
5300 struct font_name
*font
;
5303 if (EQ (Vscalable_fonts_allowed
, Qt
))
5305 else if (CONSP (Vscalable_fonts_allowed
))
5307 Lisp_Object tail
, regexp
;
5309 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5311 regexp
= XCAR (tail
);
5312 if (STRINGP (regexp
)
5313 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5321 #endif /* SCALABLE_FONTS != 0 */
5324 /* Return the name of the best matching font for face attributes
5325 ATTRS in the array of font_name structures FONTS which contains
5326 NFONTS elements. Value is a font name which is allocated from
5327 the heap. FONTS is freed by this function. */
5330 best_matching_font (f
, attrs
, fonts
, nfonts
)
5333 struct font_name
*fonts
;
5337 struct font_name
*best
;
5345 /* Make specified font attributes available in `specified',
5346 indexed by sort order. */
5347 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5349 int xlfd_idx
= font_sort_order
[i
];
5351 if (xlfd_idx
== XLFD_SWIDTH
)
5352 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5353 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5354 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5355 else if (xlfd_idx
== XLFD_WEIGHT
)
5356 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5357 else if (xlfd_idx
== XLFD_SLANT
)
5358 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5368 /* Start with the first non-scalable font in the list. */
5369 for (i
= 0; i
< nfonts
; ++i
)
5370 if (!font_scalable_p (fonts
+ i
))
5373 /* Find the best match among the non-scalable fonts. */
5378 for (i
= 1; i
< nfonts
; ++i
)
5379 if (!font_scalable_p (fonts
+ i
)
5380 && better_font_p (specified
, fonts
+ i
, best
, 1))
5384 exact_p
= exact_face_match_p (specified
, best
);
5393 /* Unless we found an exact match among non-scalable fonts, see if
5394 we can find a better match among scalable fonts. */
5397 /* A scalable font is better if
5399 1. its weight, slant, swidth attributes are better, or.
5401 2. the best non-scalable font doesn't have the required
5402 point size, and the scalable fonts weight, slant, swidth
5405 int non_scalable_has_exact_height_p
;
5407 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5408 non_scalable_has_exact_height_p
= 1;
5410 non_scalable_has_exact_height_p
= 0;
5412 for (i
= 0; i
< nfonts
; ++i
)
5413 if (font_scalable_p (fonts
+ i
))
5416 || better_font_p (specified
, fonts
+ i
, best
, 0)
5417 || (!non_scalable_has_exact_height_p
5418 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5423 if (font_scalable_p (best
))
5424 font_name
= build_scalable_font_name (f
, best
, pt
);
5426 font_name
= build_font_name (best
);
5428 #else /* !SCALABLE_FONTS */
5430 /* Find the best non-scalable font. */
5433 for (i
= 1; i
< nfonts
; ++i
)
5435 xassert (!font_scalable_p (fonts
+ i
));
5436 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5440 font_name
= build_font_name (best
);
5442 #endif /* !SCALABLE_FONTS */
5444 /* Free font_name structures. */
5445 free_font_names (fonts
, nfonts
);
5451 /* Try to get a list of fonts on frame F with font family FAMILY and
5452 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5453 of font_name structures for the fonts matched. Value is the number
5457 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5460 Lisp_Object pattern
, family
, registry
;
5461 struct font_name
**fonts
;
5465 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5466 family
= attrs
[LFACE_FAMILY_INDEX
];
5468 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5470 if (nfonts
== 0 && !NILP (family
))
5474 /* Try alternative font families from
5475 Vface_alternative_font_family_alist. */
5476 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5478 for (alter
= XCDR (alter
);
5479 CONSP (alter
) && nfonts
== 0;
5480 alter
= XCDR (alter
))
5482 if (STRINGP (XCAR (alter
)))
5483 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5486 /* Try font family of the default face or "fixed". */
5489 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5491 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5493 family
= build_string ("fixed");
5494 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5497 /* Try any family with the given registry. */
5499 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5506 /* Return the fontset id of the base fontset name or alias name given
5507 by the fontset attribute of ATTRS. Value is -1 if the fontset
5508 attribute of ATTRS doesn't name a fontset. */
5511 face_fontset (attrs
)
5517 name
= attrs
[LFACE_FONT_INDEX
];
5518 if (!STRINGP (name
))
5520 return fs_query_fontset (name
, 0);
5524 /* Choose a name of font to use on frame F to display character C with
5525 Lisp face attributes specified by ATTRS. The font name is
5526 determined by the font-related attributes in ATTRS and the name
5527 pattern for C in FONTSET. Value is the font name which is
5528 allocated from the heap and must be freed by the caller, or NULL if
5529 we can get no information about the font name of C. It is assured
5530 that we always get some information for a single byte
5534 choose_face_font (f
, attrs
, fontset
, c
)
5539 Lisp_Object pattern
;
5540 char *font_name
= NULL
;
5541 struct font_name
*fonts
;
5544 /* Get (foundry and) family name and registry (and encoding) name of
5546 pattern
= fontset_font_pattern (f
, fontset
, c
);
5549 xassert (!SINGLE_BYTE_CHAR_P (c
));
5552 /* If what we got is a name pattern, return it. */
5553 if (STRINGP (pattern
))
5554 return xstrdup (XSTRING (pattern
)->data
);
5556 /* Family name may be specified both in ATTRS and car part of
5557 PATTERN. The former has higher priority if C is a single byte
5559 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5560 && SINGLE_BYTE_CHAR_P (c
))
5561 XCAR (pattern
) = Qnil
;
5563 /* Get a list of fonts matching that pattern and choose the
5564 best match for the specified face attributes from it. */
5565 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
5567 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5571 #endif /* HAVE_WINDOW_SYSTEM */
5575 /***********************************************************************
5577 ***********************************************************************/
5579 /* Realize basic faces on frame F. Value is zero if frame parameters
5580 of F don't contain enough information needed to realize the default
5584 realize_basic_faces (f
)
5589 /* Block input there so that we won't be surprised by an X expose
5590 event, for instance without having the faces set up. */
5593 if (realize_default_face (f
))
5595 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5596 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5597 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5598 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5599 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5600 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5601 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5602 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5603 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5612 /* Realize the default face on frame F. If the face is not fully
5613 specified, make it fully-specified. Attributes of the default face
5614 that are not explicitly specified are taken from frame parameters. */
5617 realize_default_face (f
)
5620 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5622 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5623 Lisp_Object frame_font
;
5627 /* If the `default' face is not yet known, create it. */
5628 lface
= lface_from_face_name (f
, Qdefault
, 0);
5632 XSETFRAME (frame
, f
);
5633 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5636 #ifdef HAVE_WINDOW_SYSTEM
5637 if (FRAME_WINDOW_P (f
))
5639 /* Set frame_font to the value of the `font' frame parameter. */
5640 frame_font
= Fassq (Qfont
, f
->param_alist
);
5641 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5642 frame_font
= XCDR (frame_font
);
5643 set_lface_from_font_name (f
, lface
, frame_font
, 0, 1);
5645 #endif /* HAVE_WINDOW_SYSTEM */
5647 if (!FRAME_WINDOW_P (f
))
5649 LFACE_FAMILY (lface
) = build_string ("default");
5650 LFACE_SWIDTH (lface
) = Qnormal
;
5651 LFACE_HEIGHT (lface
) = make_number (1);
5652 LFACE_WEIGHT (lface
) = Qnormal
;
5653 LFACE_SLANT (lface
) = Qnormal
;
5656 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5657 LFACE_UNDERLINE (lface
) = Qnil
;
5659 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5660 LFACE_OVERLINE (lface
) = Qnil
;
5662 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5663 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5665 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5666 LFACE_BOX (lface
) = Qnil
;
5668 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5669 LFACE_INVERSE (lface
) = Qnil
;
5671 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5673 /* This function is called so early that colors are not yet
5674 set in the frame parameter list. */
5675 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5677 if (CONSP (color
) && STRINGP (XCDR (color
)))
5678 LFACE_FOREGROUND (lface
) = XCDR (color
);
5679 else if (FRAME_WINDOW_P (f
))
5681 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5682 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5687 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5689 /* This function is called so early that colors are not yet
5690 set in the frame parameter list. */
5691 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5692 if (CONSP (color
) && STRINGP (XCDR (color
)))
5693 LFACE_BACKGROUND (lface
) = XCDR (color
);
5694 else if (FRAME_WINDOW_P (f
))
5696 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5697 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5702 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5703 LFACE_STIPPLE (lface
) = Qnil
;
5705 /* Realize the face; it must be fully-specified now. */
5706 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5707 check_lface (lface
);
5708 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5709 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
5714 /* Realize basic faces other than the default face in face cache C.
5715 SYMBOL is the face name, ID is the face id the realized face must
5716 have. The default face must have been realized already. */
5719 realize_named_face (f
, symbol
, id
)
5724 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5725 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5726 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5727 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5728 struct face
*new_face
;
5730 /* The default face must exist and be fully specified. */
5731 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5732 check_lface_attrs (attrs
);
5733 xassert (lface_fully_specified_p (attrs
));
5735 /* If SYMBOL isn't know as a face, create it. */
5739 XSETFRAME (frame
, f
);
5740 lface
= Finternal_make_lisp_face (symbol
, frame
);
5743 /* Merge SYMBOL's face with the default face. */
5744 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5745 merge_face_vectors (symbol_attrs
, attrs
);
5747 /* Realize the face. */
5748 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
5752 /* Realize the fully-specified face with attributes ATTRS in face
5753 cache CACHE for character C. If C is a multibyte character,
5754 BASE_FACE is a face for ASCII characters that has the same
5755 attributes. Otherwise, BASE_FACE is ignored. If FORMER_FACE_ID is
5756 non-negative, it is an ID of face to remove before caching the new
5757 face. Value is a pointer to the newly created realized face. */
5759 static struct face
*
5760 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
5761 struct face_cache
*cache
;
5764 struct face
*base_face
;
5769 /* LFACE must be fully specified. */
5770 xassert (cache
!= NULL
);
5771 check_lface_attrs (attrs
);
5773 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5775 /* Remove the former face. */
5776 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5777 uncache_face (cache
, former_face
);
5778 free_realized_face (cache
->f
, former_face
);
5781 if (FRAME_WINDOW_P (cache
->f
))
5782 face
= realize_x_face (cache
, attrs
, c
, base_face
);
5783 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5784 face
= realize_tty_face (cache
, attrs
, c
);
5788 /* Insert the new face. */
5789 cache_face (cache
, face
, lface_hash (attrs
));
5790 #ifdef HAVE_WINDOW_SYSTEM
5791 if (FRAME_X_P (cache
->f
) && face
->font
== NULL
)
5792 load_face_font (cache
->f
, face
, c
);
5793 #endif /* HAVE_WINDOW_SYSTEM */
5798 /* Realize the fully-specified face with attributes ATTRS in face
5799 cache CACHE for character C. Do it for X frame CACHE->f. If C is
5800 a multibyte character, BASE_FACE is a face for ASCII characters
5801 that has the same attributes. Otherwise, BASE_FACE is ignored. If
5802 the new face doesn't share font with the default face, a fontname
5803 is allocated from the heap and set in `font_name' of the new face,
5804 but it is not yet loaded here. Value is a pointer to the newly
5805 created realized face. */
5807 static struct face
*
5808 realize_x_face (cache
, attrs
, c
, base_face
)
5809 struct face_cache
*cache
;
5812 struct face
*base_face
;
5814 #ifdef HAVE_WINDOW_SYSTEM
5815 struct face
*face
, *default_face
;
5817 Lisp_Object stipple
, overline
, strike_through
, box
;
5819 xassert (FRAME_WINDOW_P (cache
->f
));
5820 xassert (SINGLE_BYTE_CHAR_P (c
)
5821 || (base_face
&& base_face
->ascii_face
== base_face
));
5823 /* Allocate a new realized face. */
5824 face
= make_realized_face (attrs
);
5828 /* If C is a multibyte character, we share all face attirbutes with
5829 BASE_FACE including the realized fontset. But, we must load a
5831 if (!SINGLE_BYTE_CHAR_P (c
))
5833 bcopy (base_face
, face
, sizeof *face
);
5835 face
->font
= NULL
; /* to force realize_face to load font */
5839 /* Now we are realizing a face for ASCII (and unibyte) characters. */
5841 /* Determine the font to use. Most of the time, the font will be
5842 the same as the font of the default face, so try that first. */
5843 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5845 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
5846 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5848 face
->font
= default_face
->font
;
5849 face
->fontset
= default_face
->fontset
;
5850 face
->font_info_id
= default_face
->font_info_id
;
5851 face
->font_name
= default_face
->font_name
;
5852 face
->ascii_face
= face
;
5854 /* But, as we can't share the fontset, make a new realized
5855 fontset that has the same base fontset as of the default
5858 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
5862 /* If the face attribute ATTRS specifies a fontset, use it as
5863 the base of a new realized fontset. Otherwise, use the
5864 default fontset as the base. The base determines registry
5865 and encoding of a font. It may also determine foundry and
5866 family. The other fields of font name pattern are
5867 constructed from ATTRS. */
5869 = make_fontset_for_ascii_face (f
, face_fontset (attrs
));
5870 face
->font
= NULL
; /* to force realize_face to load font */
5873 /* Load colors, and set remaining attributes. */
5875 load_face_colors (f
, face
, attrs
);
5878 box
= attrs
[LFACE_BOX_INDEX
];
5881 /* A simple box of line width 1 drawn in color given by
5883 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5885 face
->box
= FACE_SIMPLE_BOX
;
5886 face
->box_line_width
= 1;
5888 else if (INTEGERP (box
))
5890 /* Simple box of specified line width in foreground color of the
5892 xassert (XINT (box
) > 0);
5893 face
->box
= FACE_SIMPLE_BOX
;
5894 face
->box_line_width
= XFASTINT (box
);
5895 face
->box_color
= face
->foreground
;
5896 face
->box_color_defaulted_p
= 1;
5898 else if (CONSP (box
))
5900 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5901 being one of `raised' or `sunken'. */
5902 face
->box
= FACE_SIMPLE_BOX
;
5903 face
->box_color
= face
->foreground
;
5904 face
->box_color_defaulted_p
= 1;
5905 face
->box_line_width
= 1;
5909 Lisp_Object keyword
, value
;
5911 keyword
= XCAR (box
);
5919 if (EQ (keyword
, QCline_width
))
5921 if (INTEGERP (value
) && XINT (value
) > 0)
5922 face
->box_line_width
= XFASTINT (value
);
5924 else if (EQ (keyword
, QCcolor
))
5926 if (STRINGP (value
))
5928 face
->box_color
= load_color (f
, face
, value
,
5930 face
->use_box_color_for_shadows_p
= 1;
5933 else if (EQ (keyword
, QCstyle
))
5935 if (EQ (value
, Qreleased_button
))
5936 face
->box
= FACE_RAISED_BOX
;
5937 else if (EQ (value
, Qpressed_button
))
5938 face
->box
= FACE_SUNKEN_BOX
;
5943 /* Text underline, overline, strike-through. */
5945 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5947 /* Use default color (same as foreground color). */
5948 face
->underline_p
= 1;
5949 face
->underline_defaulted_p
= 1;
5950 face
->underline_color
= 0;
5952 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5954 /* Use specified color. */
5955 face
->underline_p
= 1;
5956 face
->underline_defaulted_p
= 0;
5957 face
->underline_color
5958 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5959 LFACE_UNDERLINE_INDEX
);
5961 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5963 face
->underline_p
= 0;
5964 face
->underline_defaulted_p
= 0;
5965 face
->underline_color
= 0;
5968 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5969 if (STRINGP (overline
))
5971 face
->overline_color
5972 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5973 LFACE_OVERLINE_INDEX
);
5974 face
->overline_p
= 1;
5976 else if (EQ (overline
, Qt
))
5978 face
->overline_color
= face
->foreground
;
5979 face
->overline_color_defaulted_p
= 1;
5980 face
->overline_p
= 1;
5983 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5984 if (STRINGP (strike_through
))
5986 face
->strike_through_color
5987 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5988 LFACE_STRIKE_THROUGH_INDEX
);
5989 face
->strike_through_p
= 1;
5991 else if (EQ (strike_through
, Qt
))
5993 face
->strike_through_color
= face
->foreground
;
5994 face
->strike_through_color_defaulted_p
= 1;
5995 face
->strike_through_p
= 1;
5998 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5999 if (!NILP (stipple
))
6000 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6002 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6004 #endif /* HAVE_WINDOW_SYSTEM */
6008 /* Realize the fully-specified face with attributes ATTRS in face
6009 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6010 pointer to the newly created realized face. */
6012 static struct face
*
6013 realize_tty_face (cache
, attrs
, c
)
6014 struct face_cache
*cache
;
6021 Lisp_Object tty_defined_color_alist
6022 = find_symbol_value (intern ("tty-defined-color-alist"));
6023 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6025 int face_colors_defaulted
= 0;
6027 /* Frame must be a termcap frame. */
6028 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6030 /* Allocate a new realized face. */
6031 face
= make_realized_face (attrs
);
6032 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6034 /* Map face attributes to TTY appearances. We map slant to
6035 dimmed text because we want italic text to appear differently
6036 and because dimmed text is probably used infrequently. */
6037 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6038 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6040 if (weight
> XLFD_WEIGHT_MEDIUM
)
6041 face
->tty_bold_p
= 1;
6042 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6043 face
->tty_dim_p
= 1;
6044 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6045 face
->tty_underline_p
= 1;
6046 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6047 face
->tty_reverse_p
= 1;
6049 /* Map color names to color indices. */
6050 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6051 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6053 XSETFRAME (frame
, cache
->f
);
6054 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6056 && XSTRING (color
)->size
6057 && CONSP (tty_defined_color_alist
)
6058 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6060 /* Associations in tty-defined-color-alist are of the form
6061 (NAME INDEX R G B). We need the INDEX part. */
6062 face
->foreground
= XINT (XCAR (XCDR (color
)));
6064 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6065 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6067 face
->foreground
= load_color (cache
->f
, face
,
6068 attrs
[LFACE_FOREGROUND_INDEX
],
6069 LFACE_FOREGROUND_INDEX
);
6071 #if defined (MSDOS) || defined (WINDOWSNT)
6072 /* If the foreground of the default face is the default color,
6073 use the foreground color defined by the frame. */
6075 if (FRAME_MSDOS_P (cache
->f
))
6079 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6080 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6082 face
->foreground
= FRAME_FOREGROUND_PIXEL (cache
->f
);
6083 attrs
[LFACE_FOREGROUND_INDEX
] =
6084 tty_color_name (cache
->f
, face
->foreground
);
6085 face_colors_defaulted
= 1;
6087 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6089 face
->foreground
= FRAME_BACKGROUND_PIXEL (cache
->f
);
6090 attrs
[LFACE_FOREGROUND_INDEX
] =
6091 tty_color_name (cache
->f
, face
->foreground
);
6092 face_colors_defaulted
= 1;
6097 #endif /* MSDOS or WINDOWSNT */
6100 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6102 && XSTRING (color
)->size
6103 && CONSP (tty_defined_color_alist
)
6104 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6106 /* Associations in tty-defined-color-alist are of the form
6107 (NAME INDEX R G B). We need the INDEX part. */
6108 face
->background
= XINT (XCAR (XCDR (color
)));
6110 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6111 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6113 face
->background
= load_color (cache
->f
, face
,
6114 attrs
[LFACE_BACKGROUND_INDEX
],
6115 LFACE_BACKGROUND_INDEX
);
6116 #if defined (MSDOS) || defined (WINDOWSNT)
6117 /* If the background of the default face is the default color,
6118 use the background color defined by the frame. */
6120 if (FRAME_MSDOS_P (cache
->f
))
6124 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6125 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6127 face
->background
= FRAME_BACKGROUND_PIXEL (cache
->f
);
6128 attrs
[LFACE_BACKGROUND_INDEX
] =
6129 tty_color_name (cache
->f
, face
->background
);
6130 face_colors_defaulted
= 1;
6132 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6134 face
->background
= FRAME_FOREGROUND_PIXEL (cache
->f
);
6135 attrs
[LFACE_BACKGROUND_INDEX
] =
6136 tty_color_name (cache
->f
, face
->background
);
6137 face_colors_defaulted
= 1;
6142 #endif /* MSDOS or WINDOWSNT */
6145 /* Swap colors if face is inverse-video. If the colors are taken
6146 from the frame colors, they are already inverted, since the
6147 frame-creation function calls x-handle-reverse-video. */
6148 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6150 unsigned long tem
= face
->foreground
;
6152 face
->foreground
= face
->background
;
6153 face
->background
= tem
;
6161 /***********************************************************************
6163 ***********************************************************************/
6165 /* Return the ID of the face to use to display character CH with face
6166 property PROP on frame F in current_buffer. */
6169 compute_char_face (f
, ch
, prop
)
6176 if (NILP (current_buffer
->enable_multibyte_characters
))
6181 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6182 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6186 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6187 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6188 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6189 merge_face_vector_with_property (f
, attrs
, prop
);
6190 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6197 /* Return the face ID associated with buffer position POS for
6198 displaying ASCII characters. Return in *ENDPTR the position at
6199 which a different face is needed, as far as text properties and
6200 overlays are concerned. W is a window displaying current_buffer.
6202 REGION_BEG, REGION_END delimit the region, so it can be
6205 LIMIT is a position not to scan beyond. That is to limit the time
6206 this function can take.
6208 If MOUSE is non-zero, use the character's mouse-face, not its face.
6210 The face returned is suitable for displaying ASCII characters. */
6213 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6214 endptr
, limit
, mouse
)
6217 int region_beg
, region_end
;
6222 struct frame
*f
= XFRAME (w
->frame
);
6223 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6224 Lisp_Object prop
, position
;
6226 Lisp_Object
*overlay_vec
;
6229 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6230 Lisp_Object limit1
, end
;
6231 struct face
*default_face
;
6232 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6234 /* W must display the current buffer. We could write this function
6235 to use the frame and buffer of W, but right now it doesn't. */
6236 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6238 XSETFRAME (frame
, f
);
6239 XSETFASTINT (position
, pos
);
6242 if (pos
< region_beg
&& region_beg
< endpos
)
6243 endpos
= region_beg
;
6245 /* Get the `face' or `mouse_face' text property at POS, and
6246 determine the next position at which the property changes. */
6247 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6248 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6249 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6251 endpos
= XINT (end
);
6253 /* Look at properties from overlays. */
6258 /* First try with room for 40 overlays. */
6260 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6261 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6262 &next_overlay
, NULL
);
6264 /* If there are more than 40, make enough space for all, and try
6266 if (noverlays
> len
)
6269 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6270 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6271 &next_overlay
, NULL
);
6274 if (next_overlay
< endpos
)
6275 endpos
= next_overlay
;
6280 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6282 /* Optimize common cases where we can use the default face. */
6285 && !(pos
>= region_beg
&& pos
< region_end
))
6286 return DEFAULT_FACE_ID
;
6288 /* Begin with attributes from the default face. */
6289 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6291 /* Merge in attributes specified via text properties. */
6293 merge_face_vector_with_property (f
, attrs
, prop
);
6295 /* Now merge the overlay data. */
6296 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6297 for (i
= 0; i
< noverlays
; i
++)
6302 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6304 merge_face_vector_with_property (f
, attrs
, prop
);
6306 oend
= OVERLAY_END (overlay_vec
[i
]);
6307 oendpos
= OVERLAY_POSITION (oend
);
6308 if (oendpos
< endpos
)
6312 /* If in the region, merge in the region face. */
6313 if (pos
>= region_beg
&& pos
< region_end
)
6315 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6316 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6318 if (region_end
< endpos
)
6319 endpos
= region_end
;
6324 /* Look up a realized face with the given face attributes,
6325 or realize a new one for ASCII characters. */
6326 return lookup_face (f
, attrs
, 0, NULL
);
6330 /* Compute the face at character position POS in Lisp string STRING on
6331 window W, for ASCII characters.
6333 If STRING is an overlay string, it comes from position BUFPOS in
6334 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6335 not an overlay string. W must display the current buffer.
6336 REGION_BEG and REGION_END give the start and end positions of the
6337 region; both are -1 if no region is visible. BASE_FACE_ID is the
6338 id of the basic face to merge with. It is usually equal to
6339 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6340 for strings displayed in the mode or top line.
6342 Set *ENDPTR to the next position where to check for faces in
6343 STRING; -1 if the face is constant from POS to the end of the
6346 Value is the id of the face to use. The face returned is suitable
6347 for displaying ASCII characters. */
6350 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6351 region_end
, endptr
, base_face_id
)
6355 int region_beg
, region_end
;
6357 enum face_id base_face_id
;
6359 Lisp_Object prop
, position
, end
, limit
;
6360 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6361 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6362 struct face
*base_face
;
6363 int multibyte_p
= STRING_MULTIBYTE (string
);
6365 /* Get the value of the face property at the current position within
6366 STRING. Value is nil if there is no face property. */
6367 XSETFASTINT (position
, pos
);
6368 prop
= Fget_text_property (position
, Qface
, string
);
6370 /* Get the next position at which to check for faces. Value of end
6371 is nil if face is constant all the way to the end of the string.
6372 Otherwise it is a string position where to check faces next.
6373 Limit is the maximum position up to which to check for property
6374 changes in Fnext_single_property_change. Strings are usually
6375 short, so set the limit to the end of the string. */
6376 XSETFASTINT (limit
, XSTRING (string
)->size
);
6377 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6379 *endptr
= XFASTINT (end
);
6383 base_face
= FACE_FROM_ID (f
, base_face_id
);
6384 xassert (base_face
);
6386 /* Optimize the default case that there is no face property and we
6387 are not in the region. */
6389 && (base_face_id
!= DEFAULT_FACE_ID
6390 /* BUFPOS <= 0 means STRING is not an overlay string, so
6391 that the region doesn't have to be taken into account. */
6393 || bufpos
< region_beg
6394 || bufpos
>= region_end
)
6396 /* We can't realize faces for different charsets differently
6397 if we don't have fonts, so we can stop here if not working
6398 on a window-system frame. */
6399 || !FRAME_WINDOW_P (f
)
6400 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6401 return base_face
->id
;
6403 /* Begin with attributes from the base face. */
6404 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6406 /* Merge in attributes specified via text properties. */
6408 merge_face_vector_with_property (f
, attrs
, prop
);
6410 /* If in the region, merge in the region face. */
6412 && bufpos
>= region_beg
6413 && bufpos
< region_end
)
6415 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6416 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6419 /* Look up a realized face with the given face attributes,
6420 or realize a new one for ASCII characters. */
6421 return lookup_face (f
, attrs
, 0, NULL
);
6426 /***********************************************************************
6428 ***********************************************************************/
6432 /* Print the contents of the realized face FACE to stderr. */
6435 dump_realized_face (face
)
6438 fprintf (stderr
, "ID: %d\n", face
->id
);
6439 #ifdef HAVE_X_WINDOWS
6440 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6442 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6444 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6445 fprintf (stderr
, "background: 0x%lx (%s)\n",
6447 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6448 fprintf (stderr
, "font_name: %s (%s)\n",
6450 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6451 #ifdef HAVE_X_WINDOWS
6452 fprintf (stderr
, "font = %p\n", face
->font
);
6454 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6455 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6456 fprintf (stderr
, "underline: %d (%s)\n",
6458 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6459 fprintf (stderr
, "hash: %d\n", face
->hash
);
6460 fprintf (stderr
, "charset: %d\n", face
->charset
);
6464 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6472 fprintf (stderr
, "font selection order: ");
6473 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6474 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6475 fprintf (stderr
, "\n");
6477 fprintf (stderr
, "alternative fonts: ");
6478 debug_print (Vface_alternative_font_family_alist
);
6479 fprintf (stderr
, "\n");
6481 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6482 Fdump_face (make_number (i
));
6487 CHECK_NUMBER (n
, 0);
6488 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6490 error ("Not a valid face");
6491 dump_realized_face (face
);
6498 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6502 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6503 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6504 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6508 #endif /* GLYPH_DEBUG != 0 */
6512 /***********************************************************************
6514 ***********************************************************************/
6519 Qface
= intern ("face");
6521 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6522 staticpro (&Qbitmap_spec_p
);
6523 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6524 staticpro (&Qframe_update_face_colors
);
6526 /* Lisp face attribute keywords. */
6527 QCfamily
= intern (":family");
6528 staticpro (&QCfamily
);
6529 QCheight
= intern (":height");
6530 staticpro (&QCheight
);
6531 QCweight
= intern (":weight");
6532 staticpro (&QCweight
);
6533 QCslant
= intern (":slant");
6534 staticpro (&QCslant
);
6535 QCunderline
= intern (":underline");
6536 staticpro (&QCunderline
);
6537 QCinverse_video
= intern (":inverse-video");
6538 staticpro (&QCinverse_video
);
6539 QCreverse_video
= intern (":reverse-video");
6540 staticpro (&QCreverse_video
);
6541 QCforeground
= intern (":foreground");
6542 staticpro (&QCforeground
);
6543 QCbackground
= intern (":background");
6544 staticpro (&QCbackground
);
6545 QCstipple
= intern (":stipple");;
6546 staticpro (&QCstipple
);
6547 QCwidth
= intern (":width");
6548 staticpro (&QCwidth
);
6549 QCfont
= intern (":font");
6550 staticpro (&QCfont
);
6551 QCbold
= intern (":bold");
6552 staticpro (&QCbold
);
6553 QCitalic
= intern (":italic");
6554 staticpro (&QCitalic
);
6555 QCoverline
= intern (":overline");
6556 staticpro (&QCoverline
);
6557 QCstrike_through
= intern (":strike-through");
6558 staticpro (&QCstrike_through
);
6559 QCbox
= intern (":box");
6562 /* Symbols used for Lisp face attribute values. */
6563 QCcolor
= intern (":color");
6564 staticpro (&QCcolor
);
6565 QCline_width
= intern (":line-width");
6566 staticpro (&QCline_width
);
6567 QCstyle
= intern (":style");
6568 staticpro (&QCstyle
);
6569 Qreleased_button
= intern ("released-button");
6570 staticpro (&Qreleased_button
);
6571 Qpressed_button
= intern ("pressed-button");
6572 staticpro (&Qpressed_button
);
6573 Qnormal
= intern ("normal");
6574 staticpro (&Qnormal
);
6575 Qultra_light
= intern ("ultra-light");
6576 staticpro (&Qultra_light
);
6577 Qextra_light
= intern ("extra-light");
6578 staticpro (&Qextra_light
);
6579 Qlight
= intern ("light");
6580 staticpro (&Qlight
);
6581 Qsemi_light
= intern ("semi-light");
6582 staticpro (&Qsemi_light
);
6583 Qsemi_bold
= intern ("semi-bold");
6584 staticpro (&Qsemi_bold
);
6585 Qbold
= intern ("bold");
6587 Qextra_bold
= intern ("extra-bold");
6588 staticpro (&Qextra_bold
);
6589 Qultra_bold
= intern ("ultra-bold");
6590 staticpro (&Qultra_bold
);
6591 Qoblique
= intern ("oblique");
6592 staticpro (&Qoblique
);
6593 Qitalic
= intern ("italic");
6594 staticpro (&Qitalic
);
6595 Qreverse_oblique
= intern ("reverse-oblique");
6596 staticpro (&Qreverse_oblique
);
6597 Qreverse_italic
= intern ("reverse-italic");
6598 staticpro (&Qreverse_italic
);
6599 Qultra_condensed
= intern ("ultra-condensed");
6600 staticpro (&Qultra_condensed
);
6601 Qextra_condensed
= intern ("extra-condensed");
6602 staticpro (&Qextra_condensed
);
6603 Qcondensed
= intern ("condensed");
6604 staticpro (&Qcondensed
);
6605 Qsemi_condensed
= intern ("semi-condensed");
6606 staticpro (&Qsemi_condensed
);
6607 Qsemi_expanded
= intern ("semi-expanded");
6608 staticpro (&Qsemi_expanded
);
6609 Qexpanded
= intern ("expanded");
6610 staticpro (&Qexpanded
);
6611 Qextra_expanded
= intern ("extra-expanded");
6612 staticpro (&Qextra_expanded
);
6613 Qultra_expanded
= intern ("ultra-expanded");
6614 staticpro (&Qultra_expanded
);
6615 Qbackground_color
= intern ("background-color");
6616 staticpro (&Qbackground_color
);
6617 Qforeground_color
= intern ("foreground-color");
6618 staticpro (&Qforeground_color
);
6619 Qunspecified
= intern ("unspecified");
6620 staticpro (&Qunspecified
);
6622 Qface_alias
= intern ("face-alias");
6623 staticpro (&Qface_alias
);
6624 Qdefault
= intern ("default");
6625 staticpro (&Qdefault
);
6626 Qtool_bar
= intern ("tool-bar");
6627 staticpro (&Qtool_bar
);
6628 Qregion
= intern ("region");
6629 staticpro (&Qregion
);
6630 Qfringe
= intern ("fringe");
6631 staticpro (&Qfringe
);
6632 Qheader_line
= intern ("header-line");
6633 staticpro (&Qheader_line
);
6634 Qscroll_bar
= intern ("scroll-bar");
6635 staticpro (&Qscroll_bar
);
6636 Qmenu
= intern ("menu");
6638 Qcursor
= intern ("cursor");
6639 staticpro (&Qcursor
);
6640 Qborder
= intern ("border");
6641 staticpro (&Qborder
);
6642 Qmouse
= intern ("mouse");
6643 staticpro (&Qmouse
);
6644 Qtty_color_desc
= intern ("tty-color-desc");
6645 staticpro (&Qtty_color_desc
);
6646 Qtty_color_by_index
= intern ("tty-color-by-index");
6647 staticpro (&Qtty_color_by_index
);
6649 defsubr (&Sinternal_make_lisp_face
);
6650 defsubr (&Sinternal_lisp_face_p
);
6651 defsubr (&Sinternal_set_lisp_face_attribute
);
6652 #ifdef HAVE_WINDOW_SYSTEM
6653 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6655 defsubr (&Scolor_gray_p
);
6656 defsubr (&Scolor_supported_p
);
6657 defsubr (&Sinternal_get_lisp_face_attribute
);
6658 defsubr (&Sinternal_lisp_face_attribute_values
);
6659 defsubr (&Sinternal_lisp_face_equal_p
);
6660 defsubr (&Sinternal_lisp_face_empty_p
);
6661 defsubr (&Sinternal_copy_lisp_face
);
6662 defsubr (&Sinternal_merge_in_global_face
);
6663 defsubr (&Sface_font
);
6664 defsubr (&Sframe_face_alist
);
6665 defsubr (&Sinternal_set_font_selection_order
);
6666 defsubr (&Sinternal_set_alternative_font_family_alist
);
6668 defsubr (&Sdump_face
);
6669 defsubr (&Sshow_face_resources
);
6670 #endif /* GLYPH_DEBUG */
6671 defsubr (&Sclear_face_cache
);
6673 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6674 "*Limit for font matching.\n\
6675 If an integer > 0, font matching functions won't load more than\n\
6676 that number of fonts when searching for a matching font.");
6677 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6679 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6680 "List of global face definitions (for internal use only.)");
6681 Vface_new_frame_defaults
= Qnil
;
6683 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6684 "*Default stipple pattern used on monochrome displays.\n\
6685 This stipple pattern is used on monochrome displays\n\
6686 instead of shades of gray for a face background color.\n\
6687 See `set-face-stipple' for possible values for this variable.");
6688 Vface_default_stipple
= build_string ("gray3");
6690 DEFVAR_LISP ("face-alternative-font-family-alist",
6691 &Vface_alternative_font_family_alist
, "");
6692 Vface_alternative_font_family_alist
= Qnil
;
6696 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6697 "Allowed scalable fonts.\n\
6698 A value of nil means don't allow any scalable fonts.\n\
6699 A value of t means allow any scalable font.\n\
6700 Otherwise, value must be a list of regular expressions. A font may be\n\
6701 scaled if its name matches a regular expression in the list.");
6703 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
6704 by default limits the fonts available severely. */
6705 Vscalable_fonts_allowed
= Qt
;
6707 Vscalable_fonts_allowed
= Qnil
;
6709 #endif /* SCALABLE_FONTS */
6711 #ifdef HAVE_WINDOW_SYSTEM
6712 defsubr (&Sbitmap_spec_p
);
6713 defsubr (&Sx_list_fonts
);
6714 defsubr (&Sinternal_face_x_get_resource
);
6715 defsubr (&Sx_family_fonts
);
6716 defsubr (&Sx_font_family_list
);
6717 #endif /* HAVE_WINDOW_SYSTEM */