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 char *xstrdup
P_ ((char *));
441 static unsigned char *xstrlwr
P_ ((unsigned char *));
442 static void signal_error
P_ ((char *, Lisp_Object
));
443 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
444 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
445 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
446 static void free_face_colors
P_ ((struct frame
*, struct face
*));
447 static int face_color_gray_p
P_ ((struct frame
*, char *));
448 static char *build_font_name
P_ ((struct font_name
*));
449 static void free_font_names
P_ ((struct font_name
*, int));
450 static int sorted_font_list
P_ ((struct frame
*, char *,
451 int (*cmpfn
) P_ ((const void *, const void *)),
452 struct font_name
**));
453 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
454 Lisp_Object
, struct font_name
**));
455 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
456 Lisp_Object
, Lisp_Object
, struct font_name
**));
457 static int cmp_font_names
P_ ((const void *, const void *));
458 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
459 struct face
*, int));
460 static struct face
*realize_x_face
P_ ((struct face_cache
*,
461 Lisp_Object
*, int, struct face
*));
462 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
463 Lisp_Object
*, int));
464 static int realize_basic_faces
P_ ((struct frame
*));
465 static int realize_default_face
P_ ((struct frame
*));
466 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
467 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
468 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
469 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
470 static unsigned lface_hash
P_ ((Lisp_Object
*));
471 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
472 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
473 static void free_realized_face
P_ ((struct frame
*, struct face
*));
474 static void clear_face_gcs
P_ ((struct face_cache
*));
475 static void free_face_cache
P_ ((struct face_cache
*));
476 static int face_numeric_weight
P_ ((Lisp_Object
));
477 static int face_numeric_slant
P_ ((Lisp_Object
));
478 static int face_numeric_swidth
P_ ((Lisp_Object
));
479 static int face_fontset
P_ ((Lisp_Object
*));
480 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
481 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
482 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
484 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
485 Lisp_Object
, int, int));
486 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
487 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
488 static void free_realized_faces
P_ ((struct face_cache
*));
489 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
490 struct font_name
*, int));
491 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
492 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
493 static int xlfd_numeric_slant
P_ ((struct font_name
*));
494 static int xlfd_numeric_weight
P_ ((struct font_name
*));
495 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
496 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
497 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
498 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
499 static int xlfd_fixed_p
P_ ((struct font_name
*));
500 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
502 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
503 struct font_name
*, int, int));
504 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
505 struct font_name
*, int));
507 #ifdef HAVE_WINDOW_SYSTEM
509 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
510 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
511 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
512 int (*cmpfn
) P_ ((const void *, const void *))));
513 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
514 static void x_free_gc
P_ ((struct frame
*, GC
));
515 static void clear_font_table
P_ ((struct frame
*));
518 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
519 #endif /* WINDOWSNT */
521 #endif /* HAVE_WINDOW_SYSTEM */
524 /***********************************************************************
526 ***********************************************************************/
528 #ifdef HAVE_X_WINDOWS
530 #ifdef DEBUG_X_COLORS
532 /* The following is a poor mans infrastructure for debugging X color
533 allocation problems on displays with PseudoColor-8. Some X servers
534 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
535 color reference counts completely so that they don't signal an
536 error when a color is freed whose reference count is already 0.
537 Other X servers do. To help me debug this, the following code
538 implements a simple reference counting schema of its own, for a
539 single display/screen. --gerd. */
541 /* Reference counts for pixel colors. */
543 int color_count
[256];
545 /* Register color PIXEL as allocated. */
548 register_color (pixel
)
551 xassert (pixel
< 256);
552 ++color_count
[pixel
];
556 /* Register color PIXEL as deallocated. */
559 unregister_color (pixel
)
562 xassert (pixel
< 256);
563 if (color_count
[pixel
] > 0)
564 --color_count
[pixel
];
570 /* Register N colors from PIXELS as deallocated. */
573 unregister_colors (pixels
, n
)
574 unsigned long *pixels
;
578 for (i
= 0; i
< n
; ++i
)
579 unregister_color (pixels
[i
]);
582 #endif /* DEBUG_X_COLORS */
584 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
585 color values. Interrupt input must be blocked when this function
589 x_free_colors (f
, pixels
, npixels
)
591 unsigned long *pixels
;
594 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
596 /* If display has an immutable color map, freeing colors is not
597 necessary and some servers don't allow it. So don't do it. */
598 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
600 Display
*dpy
= FRAME_X_DISPLAY (f
);
601 Colormap cmap
= FRAME_X_COLORMAP (f
);
602 Screen
*screen
= FRAME_X_SCREEN (f
);
603 int default_cmap_p
= cmap
== DefaultColormapOfScreen (screen
);
607 /* Be paranoid. If using the default color map, don't ever
608 try to free the default black and white colors. */
609 int screen_no
= XScreenNumberOfScreen (screen
);
610 unsigned long black
= BlackPixel (dpy
, screen_no
);
611 unsigned long white
= WhitePixel (dpy
, screen_no
);
615 px
= (unsigned long *) alloca (npixels
* sizeof *px
);
616 for (i
= j
= 0; i
< npixels
; ++i
)
617 if (pixels
[i
] != black
&& pixels
[i
] != white
)
622 XFreeColors (dpy
, cmap
, px
, j
, 0);
623 #ifdef DEBUG_X_COLORS
624 unregister_colors (px
, j
);
630 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
631 #ifdef DEBUG_X_COLORS
632 unregister_colors (pixels
, npixels
);
638 /* Create and return a GC for use on frame F. GC values and mask
639 are given by XGCV and MASK. */
642 x_create_gc (f
, mask
, xgcv
)
649 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
656 /* Free GC which was used on frame F. */
664 xassert (--ngcs
>= 0);
665 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
669 #endif /* HAVE_X_WINDOWS */
672 /* W32 emulation of GCs */
675 x_create_gc (f
, mask
, xgcv
)
682 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
689 /* Free GC which was used on frame F. */
697 xassert (--ngcs
>= 0);
702 #endif /* WINDOWSNT */
704 /* Like strdup, but uses xmalloc. */
710 int len
= strlen (s
) + 1;
711 char *p
= (char *) xmalloc (len
);
717 /* Like stricmp. Used to compare parts of font names which are in
722 unsigned char *s1
, *s2
;
726 unsigned char c1
= tolower (*s1
);
727 unsigned char c2
= tolower (*s2
);
729 return c1
< c2
? -1 : 1;
734 return *s2
== 0 ? 0 : -1;
739 /* Like strlwr, which might not always be available. */
741 static unsigned char *
745 unsigned char *p
= s
;
754 /* Signal `error' with message S, and additional argument ARG. */
757 signal_error (s
, arg
)
761 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
765 /* If FRAME is nil, return a pointer to the selected frame.
766 Otherwise, check that FRAME is a live frame, and return a pointer
767 to it. NPARAM is the parameter number of FRAME, for
768 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
769 Lisp function definitions. */
771 static INLINE
struct frame
*
772 frame_or_selected_frame (frame
, nparam
)
777 frame
= selected_frame
;
779 CHECK_LIVE_FRAME (frame
, nparam
);
780 return XFRAME (frame
);
784 /***********************************************************************
786 ***********************************************************************/
788 /* Initialize face cache and basic faces for frame F. */
794 /* Make a face cache, if F doesn't have one. */
795 if (FRAME_FACE_CACHE (f
) == NULL
)
796 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
798 #ifdef HAVE_WINDOW_SYSTEM
799 /* Make the image cache. */
800 if (FRAME_WINDOW_P (f
))
802 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
803 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
804 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
806 #endif /* HAVE_WINDOW_SYSTEM */
808 /* Realize basic faces. Must have enough information in frame
809 parameters to realize basic faces at this point. */
810 #ifdef HAVE_X_WINDOWS
811 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
814 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
816 if (!realize_basic_faces (f
))
821 /* Free face cache of frame F. Called from Fdelete_frame. */
827 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
831 free_face_cache (face_cache
);
832 FRAME_FACE_CACHE (f
) = NULL
;
835 #ifdef HAVE_WINDOW_SYSTEM
836 if (FRAME_WINDOW_P (f
))
838 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
841 --image_cache
->refcount
;
842 if (image_cache
->refcount
== 0)
843 free_image_cache (f
);
846 #endif /* HAVE_WINDOW_SYSTEM */
850 /* Clear face caches, and recompute basic faces for frame F. Call
851 this after changing frame parameters on which those faces depend,
852 or when realized faces have been freed due to changing attributes
856 recompute_basic_faces (f
)
859 if (FRAME_FACE_CACHE (f
))
861 clear_face_cache (0);
862 if (!realize_basic_faces (f
))
868 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
869 try to free unused fonts, too. */
872 clear_face_cache (clear_fonts_p
)
875 #ifdef HAVE_WINDOW_SYSTEM
876 Lisp_Object tail
, frame
;
880 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
882 /* From time to time see if we can unload some fonts. This also
883 frees all realized faces on all frames. Fonts needed by
884 faces will be loaded again when faces are realized again. */
885 clear_font_table_count
= 0;
887 FOR_EACH_FRAME (tail
, frame
)
890 if (FRAME_WINDOW_P (f
)
891 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
893 free_all_realized_faces (frame
);
894 clear_font_table (f
);
900 /* Clear GCs of realized faces. */
901 FOR_EACH_FRAME (tail
, frame
)
904 if (FRAME_WINDOW_P (f
))
906 clear_face_gcs (FRAME_FACE_CACHE (f
));
907 clear_image_cache (f
, 0);
911 #endif /* HAVE_WINDOW_SYSTEM */
915 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
916 "Clear face caches on all frames.\n\
917 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
919 Lisp_Object thorougly
;
921 clear_face_cache (!NILP (thorougly
));
927 #ifdef HAVE_WINDOW_SYSTEM
930 /* Remove those fonts from the font table of frame F exept for the
931 default ASCII font for the frame. Called from clear_face_cache
932 from time to time. */
938 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
939 Lisp_Object rest
, frame
;
942 xassert (FRAME_WINDOW_P (f
));
944 /* Free those fonts that are not used by the frame F as the default. */
945 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
947 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
950 || font_info
->font
== FRAME_FONT (f
))
954 if (font_info
->full_name
!= font_info
->name
)
955 xfree (font_info
->full_name
);
956 xfree (font_info
->name
);
960 #ifdef HAVE_X_WINDOWS
961 XFreeFont (dpyinfo
->display
, font_info
->font
);
964 w32_unload_font (dpyinfo
, font_info
->font
);
968 /* Mark font table slot free. */
969 font_info
->font
= NULL
;
970 font_info
->name
= font_info
->full_name
= NULL
;
974 #endif /* HAVE_WINDOW_SYSTEM */
978 /***********************************************************************
980 ***********************************************************************/
982 #ifdef HAVE_WINDOW_SYSTEM
984 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
985 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
986 A bitmap specification is either a string, a file name, or a list\n\
987 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
988 HEIGHT is its height, and DATA is a string containing the bits of\n\
989 the pixmap. Bits are stored row by row, each row occupies\n\
990 (WIDTH + 7)/8 bytes.")
996 if (STRINGP (object
))
997 /* If OBJECT is a string, it's a file name. */
999 else if (CONSP (object
))
1001 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1002 HEIGHT must be integers > 0, and DATA must be string large
1003 enough to hold a bitmap of the specified size. */
1004 Lisp_Object width
, height
, data
;
1006 height
= width
= data
= Qnil
;
1010 width
= XCAR (object
);
1011 object
= XCDR (object
);
1014 height
= XCAR (object
);
1015 object
= XCDR (object
);
1017 data
= XCAR (object
);
1021 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1023 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1025 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
1030 return pixmap_p
? Qt
: Qnil
;
1034 /* Load a bitmap according to NAME (which is either a file name or a
1035 pixmap spec) for use on frame F. Value is the bitmap_id (see
1036 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1037 bitmap cannot be loaded, display a message saying so, and return
1038 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1039 if these pointers are not null. */
1042 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1045 unsigned int *w_ptr
, *h_ptr
;
1053 tem
= Fbitmap_spec_p (name
);
1055 wrong_type_argument (Qbitmap_spec_p
, name
);
1060 /* Decode a bitmap spec into a bitmap. */
1065 w
= XINT (Fcar (name
));
1066 h
= XINT (Fcar (Fcdr (name
)));
1067 bits
= Fcar (Fcdr (Fcdr (name
)));
1069 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1074 /* It must be a string -- a file name. */
1075 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1081 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1092 ++npixmaps_allocated
;
1095 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1098 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1104 #endif /* HAVE_WINDOW_SYSTEM */
1108 /***********************************************************************
1110 ***********************************************************************/
1112 #ifdef HAVE_WINDOW_SYSTEM
1114 /* Update the line_height of frame F. Return non-zero if line height
1118 frame_update_line_height (f
)
1121 int line_height
, changed_p
;
1123 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1124 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1125 FRAME_LINE_HEIGHT (f
) = line_height
;
1129 #endif /* HAVE_WINDOW_SYSTEM */
1132 /***********************************************************************
1134 ***********************************************************************/
1136 #ifdef HAVE_WINDOW_SYSTEM
1138 /* Load font of face FACE which is used on frame F to display
1139 character C. The name of the font to load is determined by lface
1140 and fontset of FACE. */
1143 load_face_font (f
, face
, c
)
1148 struct font_info
*font_info
= NULL
;
1151 face
->font_info_id
= -1;
1154 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1159 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1164 face
->font_info_id
= font_info
->font_idx
;
1165 face
->font
= font_info
->font
;
1166 face
->font_name
= font_info
->full_name
;
1169 x_free_gc (f
, face
->gc
);
1174 add_to_log ("Unable to load font %s",
1175 build_string (font_name
), Qnil
);
1179 #endif /* HAVE_WINDOW_SYSTEM */
1183 /***********************************************************************
1185 ***********************************************************************/
1187 /* A version of defined_color for non-X frames. */
1189 tty_defined_color (f
, color_name
, color_def
, alloc
)
1195 Lisp_Object color_desc
;
1196 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
,
1197 red
= 0, green
= 0, blue
= 0;
1200 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1204 XSETFRAME (frame
, f
);
1206 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1207 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1209 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1210 if (CONSP (XCDR (XCDR (color_desc
))))
1212 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1213 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1214 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1218 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1219 /* We were called early during startup, and the colors are not
1220 yet set up in tty-defined-color-alist. Don't return a failure
1221 indication, since this produces the annoying "Unable to
1222 load color" messages in the *Messages* buffer. */
1225 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1227 if (strcmp (color_name
, "unspecified-fg") == 0)
1228 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1229 else if (strcmp (color_name
, "unspecified-bg") == 0)
1230 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1233 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1236 color_def
->pixel
= color_idx
;
1237 color_def
->red
= red
;
1238 color_def
->green
= green
;
1239 color_def
->blue
= blue
;
1244 /* Decide if color named COLOR is valid for the display associated
1245 with the frame F; if so, return the rgb values in COLOR_DEF. If
1246 ALLOC is nonzero, allocate a new colormap cell.
1248 This does the right thing for any type of frame. */
1250 defined_color (f
, color_name
, color_def
, alloc
)
1256 if (!FRAME_WINDOW_P (f
))
1257 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1258 #ifdef HAVE_X_WINDOWS
1259 else if (FRAME_X_P (f
))
1260 return x_defined_color (f
, color_name
, color_def
, alloc
);
1263 else if (FRAME_W32_P (f
))
1264 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1267 else if (FRAME_MAC_P (f
))
1268 /* FIXME: mac_defined_color doesn't exist! */
1269 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1275 /* Given the index of the tty color, return its name, a Lisp string. */
1278 tty_color_name (f
, idx
)
1284 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1287 Lisp_Object coldesc
;
1289 XSETFRAME (frame
, f
);
1290 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1292 if (!NILP (coldesc
))
1293 return XCAR (coldesc
);
1296 /* We can have an MSDOG frame under -nw for a short window of
1297 opportunity before internal_terminal_init is called. DTRT. */
1298 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1299 return msdos_stdcolor_name (idx
);
1302 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1303 return build_string (unspecified_fg
);
1304 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1305 return build_string (unspecified_bg
);
1308 return vga_stdcolor_name (idx
);
1311 return Qunspecified
;
1314 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1315 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1318 face_color_gray_p (f
, color_name
)
1325 if (defined_color (f
, color_name
, &color
, 0))
1326 gray_p
= ((abs (color
.red
- color
.green
)
1327 < max (color
.red
, color
.green
) / 20)
1328 && (abs (color
.green
- color
.blue
)
1329 < max (color
.green
, color
.blue
) / 20)
1330 && (abs (color
.blue
- color
.red
)
1331 < max (color
.blue
, color
.red
) / 20));
1339 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1340 BACKGROUND_P non-zero means the color will be used as background
1344 face_color_supported_p (f
, color_name
, background_p
)
1352 XSETFRAME (frame
, f
);
1353 return (FRAME_WINDOW_P (f
)
1354 ? (!NILP (Fxw_display_color_p (frame
))
1355 || xstricmp (color_name
, "black") == 0
1356 || xstricmp (color_name
, "white") == 0
1358 && face_color_gray_p (f
, color_name
))
1359 || (!NILP (Fx_display_grayscale_p (frame
))
1360 && face_color_gray_p (f
, color_name
)))
1361 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1365 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1366 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1367 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1368 If FRAME is nil or omitted, use the selected frame.")
1370 Lisp_Object color
, frame
;
1374 CHECK_FRAME (frame
, 0);
1375 CHECK_STRING (color
, 0);
1377 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1381 DEFUN ("color-supported-p", Fcolor_supported_p
,
1382 Scolor_supported_p
, 2, 3, 0,
1383 "Return non-nil if COLOR can be displayed on FRAME.\n\
1384 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1385 If FRAME is nil or omitted, use the selected frame.\n\
1386 COLOR must be a valid color name.")
1387 (color
, frame
, background_p
)
1388 Lisp_Object frame
, color
, background_p
;
1392 CHECK_FRAME (frame
, 0);
1393 CHECK_STRING (color
, 0);
1395 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1400 /* Load color with name NAME for use by face FACE on frame F.
1401 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1402 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1403 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1404 pixel color. If color cannot be loaded, display a message, and
1405 return the foreground, background or underline color of F, but
1406 record that fact in flags of the face so that we don't try to free
1410 load_color (f
, face
, name
, target_index
)
1414 enum lface_attribute_index target_index
;
1418 xassert (STRINGP (name
));
1419 xassert (target_index
== LFACE_FOREGROUND_INDEX
1420 || target_index
== LFACE_BACKGROUND_INDEX
1421 || target_index
== LFACE_UNDERLINE_INDEX
1422 || target_index
== LFACE_OVERLINE_INDEX
1423 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1424 || target_index
== LFACE_BOX_INDEX
);
1426 /* if the color map is full, defined_color will return a best match
1427 to the values in an existing cell. */
1428 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1430 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1432 switch (target_index
)
1434 case LFACE_FOREGROUND_INDEX
:
1435 face
->foreground_defaulted_p
= 1;
1436 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1439 case LFACE_BACKGROUND_INDEX
:
1440 face
->background_defaulted_p
= 1;
1441 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1444 case LFACE_UNDERLINE_INDEX
:
1445 face
->underline_defaulted_p
= 1;
1446 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1449 case LFACE_OVERLINE_INDEX
:
1450 face
->overline_color_defaulted_p
= 1;
1451 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1454 case LFACE_STRIKE_THROUGH_INDEX
:
1455 face
->strike_through_color_defaulted_p
= 1;
1456 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1459 case LFACE_BOX_INDEX
:
1460 face
->box_color_defaulted_p
= 1;
1461 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1470 ++ncolors_allocated
;
1476 #ifdef HAVE_WINDOW_SYSTEM
1478 /* Load colors for face FACE which is used on frame F. Colors are
1479 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1480 of ATTRS. If the background color specified is not supported on F,
1481 try to emulate gray colors with a stipple from Vface_default_stipple. */
1484 load_face_colors (f
, face
, attrs
)
1491 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1492 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1494 /* Swap colors if face is inverse-video. */
1495 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1503 /* Check for support for foreground, not for background because
1504 face_color_supported_p is smart enough to know that grays are
1505 "supported" as background because we are supposed to use stipple
1507 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1508 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1510 x_destroy_bitmap (f
, face
->stipple
);
1511 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1512 &face
->pixmap_w
, &face
->pixmap_h
);
1515 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1516 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1520 /* Free color PIXEL on frame F. */
1523 unload_color (f
, pixel
)
1525 unsigned long pixel
;
1527 #ifdef HAVE_X_WINDOWS
1529 x_free_colors (f
, &pixel
, 1);
1535 /* Free colors allocated for FACE. */
1538 free_face_colors (f
, face
)
1542 #ifdef HAVE_X_WINDOWS
1543 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1545 /* If display has an immutable color map, freeing colors is not
1546 necessary and some servers don't allow it. So don't do it. */
1547 if (class != StaticColor
1548 && class != StaticGray
1549 && class != TrueColor
)
1553 if (!face
->foreground_defaulted_p
)
1555 x_free_colors (f
, &face
->foreground
, 1);
1556 IF_DEBUG (--ncolors_allocated
);
1559 if (!face
->background_defaulted_p
)
1561 x_free_colors (f
, &face
->background
, 1);
1562 IF_DEBUG (--ncolors_allocated
);
1565 if (face
->underline_p
1566 && !face
->underline_defaulted_p
)
1568 x_free_colors (f
, &face
->underline_color
, 1);
1569 IF_DEBUG (--ncolors_allocated
);
1572 if (face
->overline_p
1573 && !face
->overline_color_defaulted_p
)
1575 x_free_colors (f
, &face
->overline_color
, 1);
1576 IF_DEBUG (--ncolors_allocated
);
1579 if (face
->strike_through_p
1580 && !face
->strike_through_color_defaulted_p
)
1582 x_free_colors (f
, &face
->strike_through_color
, 1);
1583 IF_DEBUG (--ncolors_allocated
);
1586 if (face
->box
!= FACE_NO_BOX
1587 && !face
->box_color_defaulted_p
)
1589 x_free_colors (f
, &face
->box_color
, 1);
1590 IF_DEBUG (--ncolors_allocated
);
1595 #endif /* HAVE_X_WINDOWS */
1597 #endif /* HAVE_WINDOW_SYSTEM */
1601 /***********************************************************************
1603 ***********************************************************************/
1605 /* An enumerator for each field of an XLFD font name. */
1626 /* An enumerator for each possible slant value of a font. Taken from
1627 the XLFD specification. */
1635 XLFD_SLANT_REVERSE_ITALIC
,
1636 XLFD_SLANT_REVERSE_OBLIQUE
,
1640 /* Relative font weight according to XLFD documentation. */
1644 XLFD_WEIGHT_UNKNOWN
,
1645 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1646 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1647 XLFD_WEIGHT_LIGHT
, /* 30 */
1648 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1649 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1650 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1651 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1652 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1653 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1656 /* Relative proportionate width. */
1660 XLFD_SWIDTH_UNKNOWN
,
1661 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1662 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1663 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1664 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1665 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1666 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1667 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1668 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1669 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1672 /* Structure used for tables mapping XLFD weight, slant, and width
1673 names to numeric and symbolic values. */
1679 Lisp_Object
*symbol
;
1682 /* Table of XLFD slant names and their numeric and symbolic
1683 representations. This table must be sorted by slant names in
1686 static struct table_entry slant_table
[] =
1688 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1689 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1690 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1691 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1692 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1693 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1696 /* Table of XLFD weight names. This table must be sorted by weight
1697 names in ascending order. */
1699 static struct table_entry weight_table
[] =
1701 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1702 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1703 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1704 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1705 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1706 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1707 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1708 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1709 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1710 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1711 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1712 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1713 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1714 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1715 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1718 /* Table of XLFD width names. This table must be sorted by width
1719 names in ascending order. */
1721 static struct table_entry swidth_table
[] =
1723 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1724 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1725 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1726 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1727 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1728 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1729 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1730 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1731 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1732 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1733 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1734 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1735 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1736 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1737 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1740 /* Structure used to hold the result of splitting font names in XLFD
1741 format into their fields. */
1745 /* The original name which is modified destructively by
1746 split_font_name. The pointer is kept here to be able to free it
1747 if it was allocated from the heap. */
1750 /* Font name fields. Each vector element points into `name' above.
1751 Fields are NUL-terminated. */
1752 char *fields
[XLFD_LAST
];
1754 /* Numeric values for those fields that interest us. See
1755 split_font_name for which these are. */
1756 int numeric
[XLFD_LAST
];
1759 /* The frame in effect when sorting font names. Set temporarily in
1760 sort_fonts so that it is available in font comparison functions. */
1762 static struct frame
*font_frame
;
1764 /* Order by which font selection chooses fonts. The default values
1765 mean `first, find a best match for the font width, then for the
1766 font height, then for weight, then for slant.' This variable can be
1767 set via set-face-font-sort-order. */
1769 static int font_sort_order
[4];
1772 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1773 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1774 is a pointer to the matching table entry or null if no table entry
1777 static struct table_entry
*
1778 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1779 struct table_entry
*table
;
1781 struct font_name
*font
;
1784 /* Function split_font_name converts fields to lower-case, so there
1785 is no need to use xstrlwr or xstricmp here. */
1786 char *s
= font
->fields
[field_index
];
1787 int low
, mid
, high
, cmp
;
1794 mid
= (low
+ high
) / 2;
1795 cmp
= strcmp (table
[mid
].name
, s
);
1809 /* Return a numeric representation for font name field
1810 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1811 has DIM entries. Value is the numeric value found or DFLT if no
1812 table entry matches. This function is used to translate weight,
1813 slant, and swidth names of XLFD font names to numeric values. */
1816 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1817 struct table_entry
*table
;
1819 struct font_name
*font
;
1823 struct table_entry
*p
;
1824 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1825 return p
? p
->numeric
: dflt
;
1829 /* Return a symbolic representation for font name field
1830 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1831 has DIM entries. Value is the symbolic value found or DFLT if no
1832 table entry matches. This function is used to translate weight,
1833 slant, and swidth names of XLFD font names to symbols. */
1835 static INLINE Lisp_Object
1836 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1837 struct table_entry
*table
;
1839 struct font_name
*font
;
1843 struct table_entry
*p
;
1844 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1845 return p
? *p
->symbol
: dflt
;
1849 /* Return a numeric value for the slant of the font given by FONT. */
1852 xlfd_numeric_slant (font
)
1853 struct font_name
*font
;
1855 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1856 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1860 /* Return a symbol representing the weight of the font given by FONT. */
1862 static INLINE Lisp_Object
1863 xlfd_symbolic_slant (font
)
1864 struct font_name
*font
;
1866 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1867 font
, XLFD_SLANT
, Qnormal
);
1871 /* Return a numeric value for the weight of the font given by FONT. */
1874 xlfd_numeric_weight (font
)
1875 struct font_name
*font
;
1877 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1878 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1882 /* Return a symbol representing the slant of the font given by FONT. */
1884 static INLINE Lisp_Object
1885 xlfd_symbolic_weight (font
)
1886 struct font_name
*font
;
1888 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1889 font
, XLFD_WEIGHT
, Qnormal
);
1893 /* Return a numeric value for the swidth of the font whose XLFD font
1894 name fields are found in FONT. */
1897 xlfd_numeric_swidth (font
)
1898 struct font_name
*font
;
1900 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1901 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1905 /* Return a symbolic value for the swidth of FONT. */
1907 static INLINE Lisp_Object
1908 xlfd_symbolic_swidth (font
)
1909 struct font_name
*font
;
1911 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1912 font
, XLFD_SWIDTH
, Qnormal
);
1916 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1917 entries. Value is a pointer to the matching table entry or null if
1918 no element of TABLE contains SYMBOL. */
1920 static struct table_entry
*
1921 face_value (table
, dim
, symbol
)
1922 struct table_entry
*table
;
1928 xassert (SYMBOLP (symbol
));
1930 for (i
= 0; i
< dim
; ++i
)
1931 if (EQ (*table
[i
].symbol
, symbol
))
1934 return i
< dim
? table
+ i
: NULL
;
1938 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1939 entries. Value is -1 if SYMBOL is not found in TABLE. */
1942 face_numeric_value (table
, dim
, symbol
)
1943 struct table_entry
*table
;
1947 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1948 return p
? p
->numeric
: -1;
1952 /* Return a numeric value representing the weight specified by Lisp
1953 symbol WEIGHT. Value is one of the enumerators of enum
1957 face_numeric_weight (weight
)
1960 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1964 /* Return a numeric value representing the slant specified by Lisp
1965 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1968 face_numeric_slant (slant
)
1971 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1975 /* Return a numeric value representing the swidth specified by Lisp
1976 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1979 face_numeric_swidth (width
)
1982 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1986 #ifdef HAVE_WINDOW_SYSTEM
1988 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1992 struct font_name
*font
;
1994 /* Function split_font_name converts fields to lower-case, so there
1995 is no need to use tolower here. */
1996 return *font
->fields
[XLFD_SPACING
] != 'p';
2000 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2002 The actual height of the font when displayed on F depends on the
2003 resolution of both the font and frame. For example, a 10pt font
2004 designed for a 100dpi display will display larger than 10pt on a
2005 75dpi display. (It's not unusual to use fonts not designed for the
2006 display one is using. For example, some intlfonts are available in
2007 72dpi versions, only.)
2009 Value is the real point size of FONT on frame F, or 0 if it cannot
2013 xlfd_point_size (f
, font
)
2015 struct font_name
*font
;
2017 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2018 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2019 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2022 if (font_resy
== 0 || font_pt
== 0)
2025 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2031 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2032 of frame F. This function is used to guess a point size of font
2033 when only the pixel height of the font is available. */
2036 pixel_point_size (f
, pixel
)
2040 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2044 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2045 real_pt
= pixel
* 72 / resy
;
2046 int_pt
= real_pt
+ 0.5;
2052 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2053 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2054 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2055 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2056 zero if the font name doesn't have the format we expect. The
2057 expected format is a font name that starts with a `-' and has
2058 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2059 forms of font names where certain field contents are enclosed in
2060 square brackets. We don't support that, for now. */
2063 split_font_name (f
, font
, numeric_p
)
2065 struct font_name
*font
;
2071 if (*font
->name
== '-')
2073 char *p
= xstrlwr (font
->name
) + 1;
2075 while (i
< XLFD_LAST
)
2077 font
->fields
[i
] = p
;
2080 while (*p
&& *p
!= '-')
2090 success_p
= i
== XLFD_LAST
;
2092 /* If requested, and font name was in the expected format,
2093 compute numeric values for some fields. */
2094 if (numeric_p
&& success_p
)
2096 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2097 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2098 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2099 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2100 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2107 /* Build an XLFD font name from font name fields in FONT. Value is a
2108 pointer to the font name, which is allocated via xmalloc. */
2111 build_font_name (font
)
2112 struct font_name
*font
;
2116 char *font_name
= (char *) xmalloc (size
);
2117 int total_length
= 0;
2119 for (i
= 0; i
< XLFD_LAST
; ++i
)
2121 /* Add 1 because of the leading `-'. */
2122 int len
= strlen (font
->fields
[i
]) + 1;
2124 /* Reallocate font_name if necessary. Add 1 for the final
2126 if (total_length
+ len
+ 1 >= size
)
2128 int new_size
= max (2 * size
, size
+ len
+ 1);
2129 int sz
= new_size
* sizeof *font_name
;
2130 font_name
= (char *) xrealloc (font_name
, sz
);
2134 font_name
[total_length
] = '-';
2135 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2136 total_length
+= len
;
2139 font_name
[total_length
] = 0;
2144 /* Free an array FONTS of N font_name structures. This frees FONTS
2145 itself and all `name' fields in its elements. */
2148 free_font_names (fonts
, n
)
2149 struct font_name
*fonts
;
2153 xfree (fonts
[--n
].name
);
2158 /* Sort vector FONTS of font_name structures which contains NFONTS
2159 elements using qsort and comparison function CMPFN. F is the frame
2160 on which the fonts will be used. The global variable font_frame
2161 is temporarily set to F to make it available in CMPFN. */
2164 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2166 struct font_name
*fonts
;
2168 int (*cmpfn
) P_ ((const void *, const void *));
2171 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2176 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2177 display in x_display_list. FONTS is a pointer to a vector of
2178 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2179 alternative patterns from Valternate_fontname_alist if no fonts are
2180 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2183 For all fonts found, set FONTS[i].name to the name of the font,
2184 allocated via xmalloc, and split font names into fields. Ignore
2185 fonts that we can't parse. Value is the number of fonts found.
2187 This is similar to x_list_fonts. The differences are:
2189 1. It avoids consing.
2190 2. It never calls XLoadQueryFont. */
2193 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2197 struct font_name
*fonts
;
2198 int nfonts
, try_alternatives_p
;
2199 int scalable_fonts_p
;
2203 #ifdef HAVE_X_WINDOWS
2204 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2206 /* Get the list of fonts matching PATTERN from the X server. */
2208 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2212 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2213 better to do it the other way around. */
2215 Lisp_Object lpattern
, tem
;
2220 lpattern
= build_string (pattern
);
2222 /* Get the list of fonts matching PATTERN. */
2224 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2227 /* Count fonts returned */
2228 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2231 /* Allocate array. */
2233 names
= (char **) xmalloc (n
* sizeof (char *));
2235 /* Extract font names into char * array. */
2237 for (i
= 0; i
< n
; i
++)
2239 names
[i
] = XSTRING (XCAR (tem
))->data
;
2246 /* Make a copy of the font names we got from X, and
2247 split them into fields. */
2248 for (i
= j
= 0; i
< n
; ++i
)
2250 /* Make a copy of the font name. */
2251 fonts
[j
].name
= xstrdup (names
[i
]);
2253 /* Ignore fonts having a name that we can't parse. */
2254 if (!split_font_name (f
, fonts
+ j
, 1))
2255 xfree (fonts
[j
].name
);
2256 else if (font_scalable_p (fonts
+ j
))
2259 if (!scalable_fonts_p
2260 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2261 xfree (fonts
[j
].name
);
2264 #else /* !SCALABLE_FONTS */
2265 /* Always ignore scalable fonts. */
2266 xfree (fonts
[j
].name
);
2267 #endif /* !SCALABLE_FONTS */
2275 #ifdef HAVE_X_WINDOWS
2276 /* Free font names. */
2278 XFreeFontNames (names
);
2284 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2285 if (n
== 0 && try_alternatives_p
)
2287 Lisp_Object list
= Valternate_fontname_alist
;
2289 while (CONSP (list
))
2291 Lisp_Object entry
= XCAR (list
);
2293 && STRINGP (XCAR (entry
))
2294 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2301 Lisp_Object patterns
= XCAR (list
);
2304 while (CONSP (patterns
)
2305 /* If list is screwed up, give up. */
2306 && (name
= XCAR (patterns
),
2308 /* Ignore patterns equal to PATTERN because we tried that
2309 already with no success. */
2310 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2311 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2315 patterns
= XCDR (patterns
);
2323 /* Determine the first font matching PATTERN on frame F. Return in
2324 *FONT the matching font name, split into fields. Value is non-zero
2325 if a match was found. */
2328 first_font_matching (f
, pattern
, font
)
2331 struct font_name
*font
;
2334 struct font_name
*fonts
;
2336 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2337 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2341 bcopy (&fonts
[0], font
, sizeof *font
);
2343 fonts
[0].name
= NULL
;
2344 free_font_names (fonts
, nfonts
);
2351 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2352 using comparison function CMPFN. Value is the number of fonts
2353 found. If value is non-zero, *FONTS is set to a vector of
2354 font_name structures allocated from the heap containing matching
2355 fonts. Each element of *FONTS contains a name member that is also
2356 allocated from the heap. Font names in these structures are split
2357 into fields. Use free_font_names to free such an array. */
2360 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2363 int (*cmpfn
) P_ ((const void *, const void *));
2364 struct font_name
**fonts
;
2368 /* Get the list of fonts matching pattern. 100 should suffice. */
2369 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2370 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2371 nfonts
= XFASTINT (Vfont_list_limit
);
2373 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2375 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2377 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2380 /* Sort the resulting array and return it in *FONTS. If no
2381 fonts were found, make sure to set *FONTS to null. */
2383 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2394 /* Compare two font_name structures *A and *B. Value is analogous to
2395 strcmp. Sort order is given by the global variable
2396 font_sort_order. Font names are sorted so that, everything else
2397 being equal, fonts with a resolution closer to that of the frame on
2398 which they are used are listed first. The global variable
2399 font_frame is the frame on which we operate. */
2402 cmp_font_names (a
, b
)
2405 struct font_name
*x
= (struct font_name
*) a
;
2406 struct font_name
*y
= (struct font_name
*) b
;
2409 /* All strings have been converted to lower-case by split_font_name,
2410 so we can use strcmp here. */
2411 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2416 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2418 int j
= font_sort_order
[i
];
2419 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2424 /* Everything else being equal, we prefer fonts with an
2425 y-resolution closer to that of the frame. */
2426 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2427 int x_resy
= x
->numeric
[XLFD_RESY
];
2428 int y_resy
= y
->numeric
[XLFD_RESY
];
2429 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2437 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2438 is non-nil list fonts matching that pattern. Otherwise, if
2439 REGISTRY is non-nil return only fonts with that registry, otherwise
2440 return fonts of any registry. Set *FONTS to a vector of font_name
2441 structures allocated from the heap containing the fonts found.
2442 Value is the number of fonts found. */
2445 font_list (f
, pattern
, family
, registry
, fonts
)
2447 Lisp_Object pattern
, family
, registry
;
2448 struct font_name
**fonts
;
2450 char *pattern_str
, *family_str
, *registry_str
;
2454 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2455 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2457 pattern_str
= (char *) alloca (strlen (family_str
)
2458 + strlen (registry_str
)
2460 if (index (family_str
, '-'))
2461 sprintf (pattern_str
, "-%s-*-%s", family_str
, registry_str
);
2463 sprintf (pattern_str
, "-*-%s-*-%s", family_str
, registry_str
);
2466 pattern_str
= (char *) XSTRING (pattern
)->data
;
2468 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2472 /* Remove elements from LIST whose cars are `equal'. Called from
2473 x-family-fonts and x-font-family-list to remove duplicate font
2477 remove_duplicates (list
)
2480 Lisp_Object tail
= list
;
2482 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2484 Lisp_Object next
= XCDR (tail
);
2485 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2486 XCDR (tail
) = XCDR (next
);
2493 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2494 "Return a list of available fonts of family FAMILY on FRAME.\n\
2495 If FAMILY is omitted or nil, list all families.\n\
2496 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2498 If FRAME is omitted or nil, use the selected frame.\n\
2499 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2500 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2501 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2502 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2503 width, weight and slant of the font. These symbols are the same as for\n\
2504 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2505 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2506 giving the registry and encoding of the font.\n\
2507 The result list is sorted according to the current setting of\n\
2508 the face font sort order.")
2510 Lisp_Object family
, frame
;
2512 struct frame
*f
= check_x_frame (frame
);
2513 struct font_name
*fonts
;
2516 struct gcpro gcpro1
;
2519 CHECK_STRING (family
, 1);
2523 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2524 for (i
= nfonts
- 1; i
>= 0; --i
)
2526 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2529 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2531 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2532 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2533 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2534 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2535 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2536 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2537 tem
= build_font_name (fonts
+ i
);
2538 ASET (v
, 6, build_string (tem
));
2539 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2540 fonts
[i
].fields
[XLFD_ENCODING
]);
2541 ASET (v
, 7, build_string (tem
));
2544 result
= Fcons (v
, result
);
2549 remove_duplicates (result
);
2550 free_font_names (fonts
, nfonts
);
2556 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2558 "Return a list of available font families on FRAME.\n\
2559 If FRAME is omitted or nil, use the selected frame.\n\
2560 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2561 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2566 struct frame
*f
= check_x_frame (frame
);
2568 struct font_name
*fonts
;
2570 struct gcpro gcpro1
;
2571 int count
= specpdl_ptr
- specpdl
;
2574 /* Let's consider all fonts. Increase the limit for matching
2575 fonts until we have them all. */
2578 specbind (intern ("font-list-limit"), make_number (limit
));
2579 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2581 if (nfonts
== limit
)
2583 free_font_names (fonts
, nfonts
);
2592 for (i
= nfonts
- 1; i
>= 0; --i
)
2593 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2594 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2597 remove_duplicates (result
);
2598 free_font_names (fonts
, nfonts
);
2600 return unbind_to (count
, result
);
2604 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2605 "Return a list of the names of available fonts matching PATTERN.\n\
2606 If optional arguments FACE and FRAME are specified, return only fonts\n\
2607 the same size as FACE on FRAME.\n\
2608 PATTERN is a string, perhaps with wildcard characters;\n\
2609 the * character matches any substring, and\n\
2610 the ? character matches any single character.\n\
2611 PATTERN is case-insensitive.\n\
2612 FACE is a face name--a symbol.\n\
2614 The return value is a list of strings, suitable as arguments to\n\
2617 Fonts Emacs can't use may or may not be excluded\n\
2618 even if they match PATTERN and FACE.\n\
2619 The optional fourth argument MAXIMUM sets a limit on how many\n\
2620 fonts to match. The first MAXIMUM fonts are reported.\n\
2621 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2622 occupied by a character of a font. In that case, return only fonts\n\
2623 the WIDTH times as wide as FACE on FRAME.")
2624 (pattern
, face
, frame
, maximum
, width
)
2625 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2632 CHECK_STRING (pattern
, 0);
2638 CHECK_NATNUM (maximum
, 0);
2639 maxnames
= XINT (maximum
);
2643 CHECK_NUMBER (width
, 4);
2645 /* We can't simply call check_x_frame because this function may be
2646 called before any frame is created. */
2647 f
= frame_or_selected_frame (frame
, 2);
2648 if (!FRAME_WINDOW_P (f
))
2650 /* Perhaps we have not yet created any frame. */
2655 /* Determine the width standard for comparison with the fonts we find. */
2661 /* This is of limited utility since it works with character
2662 widths. Keep it for compatibility. --gerd. */
2663 int face_id
= lookup_named_face (f
, face
, 0);
2664 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2667 size
= FONT_WIDTH (face
->font
);
2669 size
= FONT_WIDTH (FRAME_FONT (f
));
2672 size
*= XINT (width
);
2676 Lisp_Object args
[2];
2678 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2680 /* We don't have to check fontsets. */
2682 args
[1] = list_fontsets (f
, pattern
, size
);
2683 return Fnconc (2, args
);
2687 #endif /* HAVE_WINDOW_SYSTEM */
2691 /***********************************************************************
2693 ***********************************************************************/
2695 /* Access face attributes of face FACE, a Lisp vector. */
2697 #define LFACE_FAMILY(LFACE) \
2698 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2699 #define LFACE_HEIGHT(LFACE) \
2700 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2701 #define LFACE_WEIGHT(LFACE) \
2702 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2703 #define LFACE_SLANT(LFACE) \
2704 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2705 #define LFACE_UNDERLINE(LFACE) \
2706 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2707 #define LFACE_INVERSE(LFACE) \
2708 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2709 #define LFACE_FOREGROUND(LFACE) \
2710 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2711 #define LFACE_BACKGROUND(LFACE) \
2712 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2713 #define LFACE_STIPPLE(LFACE) \
2714 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2715 #define LFACE_SWIDTH(LFACE) \
2716 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2717 #define LFACE_OVERLINE(LFACE) \
2718 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2719 #define LFACE_STRIKE_THROUGH(LFACE) \
2720 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2721 #define LFACE_BOX(LFACE) \
2722 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2723 #define LFACE_FONT(LFACE) \
2724 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2726 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2727 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2729 #define LFACEP(LFACE) \
2731 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2732 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2737 /* Check consistency of Lisp face attribute vector ATTRS. */
2740 check_lface_attrs (attrs
)
2743 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2744 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2745 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2746 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2747 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2748 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2749 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2750 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2751 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2752 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2753 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2754 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2755 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2756 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2757 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2758 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2759 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2760 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2761 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2762 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2763 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2764 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2765 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2766 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2767 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2768 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2769 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2770 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2771 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2772 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2773 #ifdef HAVE_WINDOW_SYSTEM
2774 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2775 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2776 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2777 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2778 || NILP (attrs
[LFACE_FONT_INDEX
])
2779 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2784 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2792 xassert (LFACEP (lface
));
2793 check_lface_attrs (XVECTOR (lface
)->contents
);
2797 #else /* GLYPH_DEBUG == 0 */
2799 #define check_lface_attrs(attrs) (void) 0
2800 #define check_lface(lface) (void) 0
2802 #endif /* GLYPH_DEBUG == 0 */
2805 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2806 to make it a symvol. If FACE_NAME is an alias for another face,
2807 return that face's name. */
2810 resolve_face_name (face_name
)
2811 Lisp_Object face_name
;
2813 Lisp_Object aliased
;
2815 if (STRINGP (face_name
))
2816 face_name
= intern (XSTRING (face_name
)->data
);
2820 aliased
= Fget (face_name
, Qface_alias
);
2824 face_name
= aliased
;
2831 /* Return the face definition of FACE_NAME on frame F. F null means
2832 return the global definition. FACE_NAME may be a string or a
2833 symbol (apparently Emacs 20.2 allows strings as face names in face
2834 text properties; ediff uses that). If FACE_NAME is an alias for
2835 another face, return that face's definition. If SIGNAL_P is
2836 non-zero, signal an error if FACE_NAME is not a valid face name.
2837 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2840 static INLINE Lisp_Object
2841 lface_from_face_name (f
, face_name
, signal_p
)
2843 Lisp_Object face_name
;
2848 face_name
= resolve_face_name (face_name
);
2851 lface
= assq_no_quit (face_name
, f
->face_alist
);
2853 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2856 lface
= XCDR (lface
);
2858 signal_error ("Invalid face", face_name
);
2860 check_lface (lface
);
2865 /* Get face attributes of face FACE_NAME from frame-local faces on
2866 frame F. Store the resulting attributes in ATTRS which must point
2867 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2868 is non-zero, signal an error if FACE_NAME does not name a face.
2869 Otherwise, value is zero if FACE_NAME is not a face. */
2872 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2874 Lisp_Object face_name
;
2881 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2884 bcopy (XVECTOR (lface
)->contents
, attrs
,
2885 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2895 /* Non-zero if all attributes in face attribute vector ATTRS are
2896 specified, i.e. are non-nil. */
2899 lface_fully_specified_p (attrs
)
2904 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2905 if (UNSPECIFIEDP (attrs
[i
]) && i
!= LFACE_FONT_INDEX
)
2908 return i
== LFACE_VECTOR_SIZE
;
2911 #ifdef HAVE_WINDOW_SYSTEM
2913 /* Set font-related attributes of Lisp face LFACE from the fullname of
2914 the font opened by FONTNAME. If FORCE_P is zero, set only
2915 unspecified attributes of LFACE. The exception is `font'
2916 attribute. It is set to FONTNAME as is regardless of FORCE_P.
2918 If FONTNAME is not available on frame F,
2919 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
2920 If the fullname is not in a valid XLFD format,
2921 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
2922 in LFACE and return 1.
2923 Otherwise, return 1. */
2926 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
2929 Lisp_Object fontname
;
2930 int force_p
, may_fail_p
;
2932 struct font_name font
;
2937 char *font_name
= XSTRING (fontname
)->data
;
2938 struct font_info
*font_info
;
2940 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
2941 fontset
= fs_query_fontset (fontname
, 0);
2943 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
2945 /* Check if FONT_NAME is surely available on the system. Usually
2946 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
2947 returns quickly. But, even if FONT_NAME is not yet cached,
2948 caching it now is not futail because we anyway load the font
2951 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
2961 font
.name
= STRDUPA (font_info
->full_name
);
2962 have_xlfd_p
= split_font_name (f
, &font
, 1);
2964 /* Set attributes only if unspecified, otherwise face defaults for
2965 new frames would never take effect. If we couldn't get a font
2966 name conforming to XLFD, set normal values. */
2968 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2973 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2974 + strlen (font
.fields
[XLFD_FOUNDRY
])
2976 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2977 font
.fields
[XLFD_FAMILY
]);
2978 val
= build_string (buffer
);
2981 val
= build_string ("*");
2982 LFACE_FAMILY (lface
) = val
;
2985 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2988 pt
= xlfd_point_size (f
, &font
);
2990 pt
= pixel_point_size (f
, font_info
->height
* 10);
2992 LFACE_HEIGHT (lface
) = make_number (pt
);
2995 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2996 LFACE_SWIDTH (lface
)
2997 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
2999 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3000 LFACE_WEIGHT (lface
)
3001 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3003 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3005 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3007 LFACE_FONT (lface
) = fontname
;
3011 #endif /* HAVE_WINDOW_SYSTEM */
3014 /* Merge two Lisp face attribute vectors FROM and TO and store the
3015 resulting attributes in TO. Every non-nil attribute of FROM
3016 overrides the corresponding attribute of TO. */
3019 merge_face_vectors (from
, to
)
3020 Lisp_Object
*from
, *to
;
3023 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3024 if (!UNSPECIFIEDP (from
[i
]))
3029 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3030 is a face property, determine the resulting face attributes on
3031 frame F, and store them in TO. PROP may be a single face
3032 specification or a list of such specifications. Each face
3033 specification can be
3035 1. A symbol or string naming a Lisp face.
3037 2. A property list of the form (KEYWORD VALUE ...) where each
3038 KEYWORD is a face attribute name, and value is an appropriate value
3041 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3042 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3043 for compatibility with 20.2.
3045 Face specifications earlier in lists take precedence over later
3049 merge_face_vector_with_property (f
, to
, prop
)
3056 Lisp_Object first
= XCAR (prop
);
3058 if (EQ (first
, Qforeground_color
)
3059 || EQ (first
, Qbackground_color
))
3061 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3062 . COLOR). COLOR must be a string. */
3063 Lisp_Object color_name
= XCDR (prop
);
3064 Lisp_Object color
= first
;
3066 if (STRINGP (color_name
))
3068 if (EQ (color
, Qforeground_color
))
3069 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3071 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3074 add_to_log ("Invalid face color", color_name
, Qnil
);
3076 else if (SYMBOLP (first
)
3077 && *XSYMBOL (first
)->name
->data
== ':')
3079 /* Assume this is the property list form. */
3080 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3082 Lisp_Object keyword
= XCAR (prop
);
3083 Lisp_Object value
= XCAR (XCDR (prop
));
3085 if (EQ (keyword
, QCfamily
))
3087 if (STRINGP (value
))
3088 to
[LFACE_FAMILY_INDEX
] = value
;
3090 add_to_log ("Illegal face font family", value
, Qnil
);
3092 else if (EQ (keyword
, QCheight
))
3094 if (INTEGERP (value
))
3095 to
[LFACE_HEIGHT_INDEX
] = value
;
3097 add_to_log ("Illegal face font height", value
, Qnil
);
3099 else if (EQ (keyword
, QCweight
))
3102 && face_numeric_weight (value
) >= 0)
3103 to
[LFACE_WEIGHT_INDEX
] = value
;
3105 add_to_log ("Illegal face weight", value
, Qnil
);
3107 else if (EQ (keyword
, QCslant
))
3110 && face_numeric_slant (value
) >= 0)
3111 to
[LFACE_SLANT_INDEX
] = value
;
3113 add_to_log ("Illegal face slant", value
, Qnil
);
3115 else if (EQ (keyword
, QCunderline
))
3120 to
[LFACE_UNDERLINE_INDEX
] = value
;
3122 add_to_log ("Illegal face underline", value
, Qnil
);
3124 else if (EQ (keyword
, QCoverline
))
3129 to
[LFACE_OVERLINE_INDEX
] = value
;
3131 add_to_log ("Illegal face overline", value
, Qnil
);
3133 else if (EQ (keyword
, QCstrike_through
))
3138 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3140 add_to_log ("Illegal face strike-through", value
, Qnil
);
3142 else if (EQ (keyword
, QCbox
))
3145 value
= make_number (1);
3146 if (INTEGERP (value
)
3150 to
[LFACE_BOX_INDEX
] = value
;
3152 add_to_log ("Illegal face box", value
, Qnil
);
3154 else if (EQ (keyword
, QCinverse_video
)
3155 || EQ (keyword
, QCreverse_video
))
3157 if (EQ (value
, Qt
) || NILP (value
))
3158 to
[LFACE_INVERSE_INDEX
] = value
;
3160 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3162 else if (EQ (keyword
, QCforeground
))
3164 if (STRINGP (value
))
3165 to
[LFACE_FOREGROUND_INDEX
] = value
;
3167 add_to_log ("Illegal face foreground", value
, Qnil
);
3169 else if (EQ (keyword
, QCbackground
))
3171 if (STRINGP (value
))
3172 to
[LFACE_BACKGROUND_INDEX
] = value
;
3174 add_to_log ("Illegal face background", value
, Qnil
);
3176 else if (EQ (keyword
, QCstipple
))
3178 #ifdef HAVE_X_WINDOWS
3179 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3180 if (!NILP (pixmap_p
))
3181 to
[LFACE_STIPPLE_INDEX
] = value
;
3183 add_to_log ("Illegal face stipple", value
, Qnil
);
3186 else if (EQ (keyword
, QCwidth
))
3189 && face_numeric_swidth (value
) >= 0)
3190 to
[LFACE_SWIDTH_INDEX
] = value
;
3192 add_to_log ("Illegal face width", value
, Qnil
);
3195 add_to_log ("Invalid attribute %s in face property",
3198 prop
= XCDR (XCDR (prop
));
3203 /* This is a list of face specs. Specifications at the
3204 beginning of the list take precedence over later
3205 specifications, so we have to merge starting with the
3206 last specification. */
3207 Lisp_Object next
= XCDR (prop
);
3209 merge_face_vector_with_property (f
, to
, next
);
3210 merge_face_vector_with_property (f
, to
, first
);
3215 /* PROP ought to be a face name. */
3216 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3218 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3220 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3225 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3226 Sinternal_make_lisp_face
, 1, 2, 0,
3227 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3228 If FACE was not known as a face before, create a new one.\n\
3229 If optional argument FRAME is specified, make a frame-local face\n\
3230 for that frame. Otherwise operate on the global face definition.\n\
3231 Value is a vector of face attributes.")
3233 Lisp_Object face
, frame
;
3235 Lisp_Object global_lface
, lface
;
3239 CHECK_SYMBOL (face
, 0);
3240 global_lface
= lface_from_face_name (NULL
, face
, 0);
3244 CHECK_LIVE_FRAME (frame
, 1);
3246 lface
= lface_from_face_name (f
, face
, 0);
3249 f
= NULL
, lface
= Qnil
;
3251 /* Add a global definition if there is none. */
3252 if (NILP (global_lface
))
3254 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3256 XVECTOR (global_lface
)->contents
[0] = Qface
;
3257 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3258 Vface_new_frame_defaults
);
3260 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3261 face id to Lisp face is given by the vector lface_id_to_name.
3262 The mapping from Lisp face to Lisp face id is given by the
3263 property `face' of the Lisp face name. */
3264 if (next_lface_id
== lface_id_to_name_size
)
3266 int new_size
= max (50, 2 * lface_id_to_name_size
);
3267 int sz
= new_size
* sizeof *lface_id_to_name
;
3268 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3269 lface_id_to_name_size
= new_size
;
3272 lface_id_to_name
[next_lface_id
] = face
;
3273 Fput (face
, Qface
, make_number (next_lface_id
));
3277 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3278 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3280 /* Add a frame-local definition. */
3285 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3287 XVECTOR (lface
)->contents
[0] = Qface
;
3288 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3291 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3292 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3295 lface
= global_lface
;
3297 xassert (LFACEP (lface
));
3298 check_lface (lface
);
3303 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3304 Sinternal_lisp_face_p
, 1, 2, 0,
3305 "Return non-nil if FACE names a face.\n\
3306 If optional second parameter FRAME is non-nil, check for the\n\
3307 existence of a frame-local face with name FACE on that frame.\n\
3308 Otherwise check for the existence of a global face.")
3310 Lisp_Object face
, frame
;
3316 CHECK_LIVE_FRAME (frame
, 1);
3317 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3320 lface
= lface_from_face_name (NULL
, face
, 0);
3326 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3327 Sinternal_copy_lisp_face
, 4, 4, 0,
3328 "Copy face FROM to TO.\n\
3329 If FRAME it t, copy the global face definition of FROM to the\n\
3330 global face definition of TO. Otherwise, copy the frame-local\n\
3331 definition of FROM on FRAME to the frame-local definition of TO\n\
3332 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3335 (from
, to
, frame
, new_frame
)
3336 Lisp_Object from
, to
, frame
, new_frame
;
3338 Lisp_Object lface
, copy
;
3340 CHECK_SYMBOL (from
, 0);
3341 CHECK_SYMBOL (to
, 1);
3342 if (NILP (new_frame
))
3347 /* Copy global definition of FROM. We don't make copies of
3348 strings etc. because 20.2 didn't do it either. */
3349 lface
= lface_from_face_name (NULL
, from
, 1);
3350 copy
= Finternal_make_lisp_face (to
, Qnil
);
3354 /* Copy frame-local definition of FROM. */
3355 CHECK_LIVE_FRAME (frame
, 2);
3356 CHECK_LIVE_FRAME (new_frame
, 3);
3357 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3358 copy
= Finternal_make_lisp_face (to
, new_frame
);
3361 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3362 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3368 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3369 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3370 "Set attribute ATTR of FACE to VALUE.\n\
3371 If optional argument FRAME is given, set the face attribute of face FACE\n\
3372 on that frame. If FRAME is t, set the attribute of the default for face\n\
3373 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3375 (face
, attr
, value
, frame
)
3376 Lisp_Object face
, attr
, value
, frame
;
3379 Lisp_Object old_value
= Qnil
;
3380 /* Set 1 if ATTR is QCfont. */
3381 int font_attr_p
= 0;
3382 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3383 int font_related_attr_p
= 0;
3385 CHECK_SYMBOL (face
, 0);
3386 CHECK_SYMBOL (attr
, 1);
3388 face
= resolve_face_name (face
);
3390 /* Set lface to the Lisp attribute vector of FACE. */
3392 lface
= lface_from_face_name (NULL
, face
, 1);
3396 frame
= selected_frame
;
3398 CHECK_LIVE_FRAME (frame
, 3);
3399 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3401 /* If a frame-local face doesn't exist yet, create one. */
3403 lface
= Finternal_make_lisp_face (face
, frame
);
3406 if (EQ (attr
, QCfamily
))
3408 if (!UNSPECIFIEDP (value
))
3410 CHECK_STRING (value
, 3);
3411 if (XSTRING (value
)->size
== 0)
3412 signal_error ("Invalid face family", value
);
3414 old_value
= LFACE_FAMILY (lface
);
3415 LFACE_FAMILY (lface
) = value
;
3416 font_related_attr_p
= 1;
3418 else if (EQ (attr
, QCheight
))
3420 if (!UNSPECIFIEDP (value
))
3422 CHECK_NUMBER (value
, 3);
3423 if (XINT (value
) <= 0)
3424 signal_error ("Invalid face height", value
);
3426 old_value
= LFACE_HEIGHT (lface
);
3427 LFACE_HEIGHT (lface
) = value
;
3428 font_related_attr_p
= 1;
3430 else if (EQ (attr
, QCweight
))
3432 if (!UNSPECIFIEDP (value
))
3434 CHECK_SYMBOL (value
, 3);
3435 if (face_numeric_weight (value
) < 0)
3436 signal_error ("Invalid face weight", value
);
3438 old_value
= LFACE_WEIGHT (lface
);
3439 LFACE_WEIGHT (lface
) = value
;
3440 font_related_attr_p
= 1;
3442 else if (EQ (attr
, QCslant
))
3444 if (!UNSPECIFIEDP (value
))
3446 CHECK_SYMBOL (value
, 3);
3447 if (face_numeric_slant (value
) < 0)
3448 signal_error ("Invalid face slant", value
);
3450 old_value
= LFACE_SLANT (lface
);
3451 LFACE_SLANT (lface
) = value
;
3452 font_related_attr_p
= 1;
3454 else if (EQ (attr
, QCunderline
))
3456 if (!UNSPECIFIEDP (value
))
3457 if ((SYMBOLP (value
)
3459 && !EQ (value
, Qnil
))
3460 /* Underline color. */
3462 && XSTRING (value
)->size
== 0))
3463 signal_error ("Invalid face underline", value
);
3465 old_value
= LFACE_UNDERLINE (lface
);
3466 LFACE_UNDERLINE (lface
) = value
;
3468 else if (EQ (attr
, QCoverline
))
3470 if (!UNSPECIFIEDP (value
))
3471 if ((SYMBOLP (value
)
3473 && !EQ (value
, Qnil
))
3474 /* Overline color. */
3476 && XSTRING (value
)->size
== 0))
3477 signal_error ("Invalid face overline", value
);
3479 old_value
= LFACE_OVERLINE (lface
);
3480 LFACE_OVERLINE (lface
) = value
;
3482 else if (EQ (attr
, QCstrike_through
))
3484 if (!UNSPECIFIEDP (value
))
3485 if ((SYMBOLP (value
)
3487 && !EQ (value
, Qnil
))
3488 /* Strike-through color. */
3490 && XSTRING (value
)->size
== 0))
3491 signal_error ("Invalid face strike-through", value
);
3493 old_value
= LFACE_STRIKE_THROUGH (lface
);
3494 LFACE_STRIKE_THROUGH (lface
) = value
;
3496 else if (EQ (attr
, QCbox
))
3500 /* Allow t meaning a simple box of width 1 in foreground color
3503 value
= make_number (1);
3505 if (UNSPECIFIEDP (value
))
3507 else if (NILP (value
))
3509 else if (INTEGERP (value
))
3510 valid_p
= XINT (value
) > 0;
3511 else if (STRINGP (value
))
3512 valid_p
= XSTRING (value
)->size
> 0;
3513 else if (CONSP (value
))
3529 if (EQ (k
, QCline_width
))
3531 if (!INTEGERP (v
) || XINT (v
) <= 0)
3534 else if (EQ (k
, QCcolor
))
3536 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3539 else if (EQ (k
, QCstyle
))
3541 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3548 valid_p
= NILP (tem
);
3554 signal_error ("Invalid face box", value
);
3556 old_value
= LFACE_BOX (lface
);
3557 LFACE_BOX (lface
) = value
;
3559 else if (EQ (attr
, QCinverse_video
)
3560 || EQ (attr
, QCreverse_video
))
3562 if (!UNSPECIFIEDP (value
))
3564 CHECK_SYMBOL (value
, 3);
3565 if (!EQ (value
, Qt
) && !NILP (value
))
3566 signal_error ("Invalid inverse-video face attribute value", value
);
3568 old_value
= LFACE_INVERSE (lface
);
3569 LFACE_INVERSE (lface
) = value
;
3571 else if (EQ (attr
, QCforeground
))
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 foreground color value", value
);
3582 old_value
= LFACE_FOREGROUND (lface
);
3583 LFACE_FOREGROUND (lface
) = value
;
3585 else if (EQ (attr
, QCbackground
))
3587 if (!UNSPECIFIEDP (value
))
3589 /* Don't check for valid color names here because it depends
3590 on the frame (display) whether the color will be valid
3591 when the face is realized. */
3592 CHECK_STRING (value
, 3);
3593 if (XSTRING (value
)->size
== 0)
3594 signal_error ("Empty background color value", value
);
3596 old_value
= LFACE_BACKGROUND (lface
);
3597 LFACE_BACKGROUND (lface
) = value
;
3599 else if (EQ (attr
, QCstipple
))
3601 #ifdef HAVE_X_WINDOWS
3602 if (!UNSPECIFIEDP (value
)
3604 && NILP (Fbitmap_spec_p (value
)))
3605 signal_error ("Invalid stipple attribute", value
);
3606 old_value
= LFACE_STIPPLE (lface
);
3607 LFACE_STIPPLE (lface
) = value
;
3608 #endif /* HAVE_X_WINDOWS */
3610 else if (EQ (attr
, QCwidth
))
3612 if (!UNSPECIFIEDP (value
))
3614 CHECK_SYMBOL (value
, 3);
3615 if (face_numeric_swidth (value
) < 0)
3616 signal_error ("Invalid face width", value
);
3618 old_value
= LFACE_SWIDTH (lface
);
3619 LFACE_SWIDTH (lface
) = value
;
3620 font_related_attr_p
= 1;
3622 else if (EQ (attr
, QCfont
))
3624 #ifdef HAVE_WINDOW_SYSTEM
3625 /* Set font-related attributes of the Lisp face from an
3630 CHECK_STRING (value
, 3);
3632 f
= SELECTED_FRAME ();
3634 f
= check_x_frame (frame
);
3636 /* VALUE may be a fontset name or an alias of fontset. In such
3637 a case, use the base fontset name. */
3638 tmp
= Fquery_fontset (value
, Qnil
);
3642 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3643 signal_error ("Invalid font or fontset name", value
);
3646 #endif /* HAVE_WINDOW_SYSTEM */
3648 else if (EQ (attr
, QCbold
))
3650 old_value
= LFACE_WEIGHT (lface
);
3651 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3652 font_related_attr_p
= 1;
3654 else if (EQ (attr
, QCitalic
))
3656 old_value
= LFACE_SLANT (lface
);
3657 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3658 font_related_attr_p
= 1;
3661 signal_error ("Invalid face attribute name", attr
);
3663 if (font_related_attr_p
3664 && !UNSPECIFIEDP (value
))
3665 /* If a font-related attribute other than QCfont is specified, the
3666 original `font' attribute nor that of default face is useless
3667 to determine a new font. Thus, we set it to nil so that font
3668 selection mechanism doesn't use it. */
3669 LFACE_FONT (lface
) = Qnil
;
3671 /* Changing a named face means that all realized faces depending on
3672 that face are invalid. Since we cannot tell which realized faces
3673 depend on the face, make sure they are all removed. This is done
3674 by incrementing face_change_count. The next call to
3675 init_iterator will then free realized faces. */
3677 && (EQ (attr
, QCfont
)
3678 || NILP (Fequal (old_value
, value
))))
3680 ++face_change_count
;
3681 ++windows_or_buffers_changed
;
3684 #ifdef HAVE_WINDOW_SYSTEM
3687 && !UNSPECIFIEDP (value
)
3688 && NILP (Fequal (old_value
, value
)))
3694 if (EQ (face
, Qdefault
))
3696 /* Changed font-related attributes of the `default' face are
3697 reflected in changed `font' frame parameters. */
3698 if ((font_related_attr_p
|| font_attr_p
)
3699 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3700 set_font_frame_param (frame
, lface
);
3701 else if (EQ (attr
, QCforeground
))
3702 param
= Qforeground_color
;
3703 else if (EQ (attr
, QCbackground
))
3704 param
= Qbackground_color
;
3707 else if (EQ (face
, Qscroll_bar
))
3709 /* Changing the colors of `scroll-bar' sets frame parameters
3710 `scroll-bar-foreground' and `scroll-bar-background'. */
3711 if (EQ (attr
, QCforeground
))
3712 param
= Qscroll_bar_foreground
;
3713 else if (EQ (attr
, QCbackground
))
3714 param
= Qscroll_bar_background
;
3717 else if (EQ (face
, Qborder
))
3719 /* Changing background color of `border' sets frame parameter
3721 if (EQ (attr
, QCbackground
))
3722 param
= Qborder_color
;
3724 else if (EQ (face
, Qcursor
))
3726 /* Changing background color of `cursor' sets frame parameter
3728 if (EQ (attr
, QCbackground
))
3729 param
= Qcursor_color
;
3731 else if (EQ (face
, Qmouse
))
3733 /* Changing background color of `mouse' sets frame parameter
3735 if (EQ (attr
, QCbackground
))
3736 param
= Qmouse_color
;
3740 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3743 #endif /* HAVE_WINDOW_SYSTEM */
3749 #ifdef HAVE_WINDOW_SYSTEM
3751 /* Set the `font' frame parameter of FRAME determined from `default'
3752 face attributes LFACE. If a face or fontset name is explicitely
3753 specfied in LFACE, use it as is. Otherwise, determine a font name
3754 from the other font-related atrributes of LFACE. In that case, if
3755 there's no matching font, signals an error. */
3758 set_font_frame_param (frame
, lface
)
3759 Lisp_Object frame
, lface
;
3761 struct frame
*f
= XFRAME (frame
);
3762 Lisp_Object font_name
;
3765 if (STRINGP (LFACE_FONT (lface
)))
3766 font_name
= LFACE_FONT (lface
);
3769 /* Choose a font name that reflects LFACE's attributes and has
3770 the registry and encoding pattern specified in the default
3771 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
3772 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
3774 error ("No font matches the specified attribute");
3775 font_name
= build_string (font
);
3778 store_frame_param (f
, Qfont
, font_name
);
3782 /* Update the corresponding face when frame parameter PARAM on frame F
3783 has been assigned the value NEW_VALUE. */
3786 update_face_from_frame_parameter (f
, param
, new_value
)
3788 Lisp_Object param
, new_value
;
3792 /* If there are no faces yet, give up. This is the case when called
3793 from Fx_create_frame, and we do the necessary things later in
3794 face-set-after-frame-defaults. */
3795 if (NILP (f
->face_alist
))
3798 if (EQ (param
, Qforeground_color
))
3800 lface
= lface_from_face_name (f
, Qdefault
, 1);
3801 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3802 ? new_value
: Qunspecified
);
3803 realize_basic_faces (f
);
3805 else if (EQ (param
, Qbackground_color
))
3809 /* Changing the background color might change the background
3810 mode, so that we have to load new defface specs. Call
3811 frame-update-face-colors to do that. */
3812 XSETFRAME (frame
, f
);
3813 call1 (Qframe_update_face_colors
, frame
);
3815 lface
= lface_from_face_name (f
, Qdefault
, 1);
3816 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3817 ? new_value
: Qunspecified
);
3818 realize_basic_faces (f
);
3820 if (EQ (param
, Qborder_color
))
3822 lface
= lface_from_face_name (f
, Qborder
, 1);
3823 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3824 ? new_value
: Qunspecified
);
3826 else if (EQ (param
, Qcursor_color
))
3828 lface
= lface_from_face_name (f
, Qcursor
, 1);
3829 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3830 ? new_value
: Qunspecified
);
3832 else if (EQ (param
, Qmouse_color
))
3834 lface
= lface_from_face_name (f
, Qmouse
, 1);
3835 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3836 ? new_value
: Qunspecified
);
3841 /* Get the value of X resource RESOURCE, class CLASS for the display
3842 of frame FRAME. This is here because ordinary `x-get-resource'
3843 doesn't take a frame argument. */
3845 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3846 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3847 (resource
, class, frame
)
3848 Lisp_Object resource
, class, frame
;
3850 Lisp_Object value
= Qnil
;
3852 CHECK_STRING (resource
, 0);
3853 CHECK_STRING (class, 1);
3854 CHECK_LIVE_FRAME (frame
, 2);
3856 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3857 resource
, class, Qnil
, Qnil
);
3864 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3865 If VALUE is "on" or "true", return t. If VALUE is "off" or
3866 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3867 error; if SIGNAL_P is zero, return 0. */
3870 face_boolean_x_resource_value (value
, signal_p
)
3874 Lisp_Object result
= make_number (0);
3876 xassert (STRINGP (value
));
3878 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3879 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3881 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3882 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3884 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3885 result
= Qunspecified
;
3887 signal_error ("Invalid face attribute value from X resource", value
);
3893 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3894 Finternal_set_lisp_face_attribute_from_resource
,
3895 Sinternal_set_lisp_face_attribute_from_resource
,
3897 (face
, attr
, value
, frame
)
3898 Lisp_Object face
, attr
, value
, frame
;
3900 CHECK_SYMBOL (face
, 0);
3901 CHECK_SYMBOL (attr
, 1);
3902 CHECK_STRING (value
, 2);
3904 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3905 value
= Qunspecified
;
3906 else if (EQ (attr
, QCheight
))
3908 value
= Fstring_to_number (value
, make_number (10));
3909 if (XINT (value
) <= 0)
3910 signal_error ("Invalid face height from X resource", value
);
3912 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3913 value
= face_boolean_x_resource_value (value
, 1);
3914 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3915 value
= intern (XSTRING (value
)->data
);
3916 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3917 value
= face_boolean_x_resource_value (value
, 1);
3918 else if (EQ (attr
, QCunderline
)
3919 || EQ (attr
, QCoverline
)
3920 || EQ (attr
, QCstrike_through
)
3921 || EQ (attr
, QCbox
))
3923 Lisp_Object boolean_value
;
3925 /* If the result of face_boolean_x_resource_value is t or nil,
3926 VALUE does NOT specify a color. */
3927 boolean_value
= face_boolean_x_resource_value (value
, 0);
3928 if (SYMBOLP (boolean_value
))
3929 value
= boolean_value
;
3932 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3935 #endif /* HAVE_WINDOW_SYSTEM */
3938 #ifdef HAVE_X_WINDOWS
3939 /***********************************************************************
3941 ***********************************************************************/
3943 #ifdef USE_X_TOOLKIT
3945 /* Structure used to pass X resources to functions called via
3946 XtApplyToWidgets. */
3957 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3958 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3961 /* Set widget W's X resources from P which points to an x_resources
3962 structure. If W is a cascade button, apply resources to W's
3966 xm_apply_resources (w
, p
)
3971 struct x_resources
*res
= (struct x_resources
*) p
;
3973 XtSetValues (w
, res
->av
, res
->ac
);
3974 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3977 XtSetValues (submenu
, res
->av
, res
->ac
);
3978 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3983 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3984 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3987 1. Setting the XmNfontList resource leads to an infinite loop
3988 somewhere in LessTif. */
3991 xm_set_menu_resources_from_menu_face (f
, widget
)
4001 lface
= lface_from_face_name (f
, Qmenu
, 1);
4002 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4004 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4006 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4010 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4012 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4016 /* If any font-related attribute of `menu' is set, set the font. */
4018 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4019 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4020 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4021 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4022 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4024 #if 0 /* Setting the font leads to an infinite loop somewhere
4025 in LessTif during geometry computation. */
4027 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4028 fl
= XmFontListAppendEntry (NULL
, fe
);
4029 XtSetArg (av
[ac
], XmNfontList
, fl
);
4034 xassert (ac
<= sizeof av
/ sizeof *av
);
4038 struct x_resources res
;
4040 XtSetValues (widget
, av
, ac
);
4041 res
.av
= av
, res
.ac
= ac
;
4042 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4044 XmFontListFree (fl
);
4049 #endif /* USE_MOTIF */
4053 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4054 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4057 /* Set widget W's resources from P which points to an x_resources
4061 xl_apply_resources (widget
, p
)
4065 struct x_resources
*res
= (struct x_resources
*) p
;
4066 XtSetValues (widget
, res
->av
, res
->ac
);
4070 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4071 This is the Lucid version. */
4074 xl_set_menu_resources_from_menu_face (f
, widget
)
4083 lface
= lface_from_face_name (f
, Qmenu
, 1);
4084 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4086 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4088 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4092 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4094 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4099 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4100 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4101 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4102 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4103 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4105 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4111 struct x_resources res
;
4113 XtSetValues (widget
, av
, ac
);
4115 /* We must do children here in case we're handling a pop-up menu
4116 in which case WIDGET is a popup shell. XtApplyToWidgets
4117 is a function from lwlib. */
4118 res
.av
= av
, res
.ac
= ac
;
4119 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4123 #endif /* USE_LUCID */
4126 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4129 x_set_menu_resources_from_menu_face (f
, widget
)
4133 /* Realized faces may have been removed on frame F, e.g. because of
4134 face attribute changes. Recompute them, if necessary, since we
4135 will need the `menu' face. */
4136 if (f
->face_cache
->used
== 0)
4137 recompute_basic_faces (f
);
4140 xl_set_menu_resources_from_menu_face (f
, widget
);
4143 xm_set_menu_resources_from_menu_face (f
, widget
);
4147 #endif /* USE_X_TOOLKIT */
4149 #endif /* HAVE_X_WINDOWS */
4153 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4154 Sinternal_get_lisp_face_attribute
,
4156 "Return face attribute KEYWORD of face SYMBOL.\n\
4157 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4158 face attribute name, signal an error.\n\
4159 If the optional argument FRAME is given, report on face FACE in that\n\
4160 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4161 frames). If FRAME is omitted or nil, use the selected frame.")
4162 (symbol
, keyword
, frame
)
4163 Lisp_Object symbol
, keyword
, frame
;
4165 Lisp_Object lface
, value
= Qnil
;
4167 CHECK_SYMBOL (symbol
, 0);
4168 CHECK_SYMBOL (keyword
, 1);
4171 lface
= lface_from_face_name (NULL
, symbol
, 1);
4175 frame
= selected_frame
;
4176 CHECK_LIVE_FRAME (frame
, 2);
4177 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4180 if (EQ (keyword
, QCfamily
))
4181 value
= LFACE_FAMILY (lface
);
4182 else if (EQ (keyword
, QCheight
))
4183 value
= LFACE_HEIGHT (lface
);
4184 else if (EQ (keyword
, QCweight
))
4185 value
= LFACE_WEIGHT (lface
);
4186 else if (EQ (keyword
, QCslant
))
4187 value
= LFACE_SLANT (lface
);
4188 else if (EQ (keyword
, QCunderline
))
4189 value
= LFACE_UNDERLINE (lface
);
4190 else if (EQ (keyword
, QCoverline
))
4191 value
= LFACE_OVERLINE (lface
);
4192 else if (EQ (keyword
, QCstrike_through
))
4193 value
= LFACE_STRIKE_THROUGH (lface
);
4194 else if (EQ (keyword
, QCbox
))
4195 value
= LFACE_BOX (lface
);
4196 else if (EQ (keyword
, QCinverse_video
)
4197 || EQ (keyword
, QCreverse_video
))
4198 value
= LFACE_INVERSE (lface
);
4199 else if (EQ (keyword
, QCforeground
))
4200 value
= LFACE_FOREGROUND (lface
);
4201 else if (EQ (keyword
, QCbackground
))
4202 value
= LFACE_BACKGROUND (lface
);
4203 else if (EQ (keyword
, QCstipple
))
4204 value
= LFACE_STIPPLE (lface
);
4205 else if (EQ (keyword
, QCwidth
))
4206 value
= LFACE_SWIDTH (lface
);
4207 else if (EQ (keyword
, QCfont
))
4208 value
= LFACE_FONT (lface
);
4210 signal_error ("Invalid face attribute name", keyword
);
4216 DEFUN ("internal-lisp-face-attribute-values",
4217 Finternal_lisp_face_attribute_values
,
4218 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4219 "Return a list of valid discrete values for face attribute ATTR.\n\
4220 Value is nil if ATTR doesn't have a discrete set of valid values.")
4224 Lisp_Object result
= Qnil
;
4226 CHECK_SYMBOL (attr
, 0);
4228 if (EQ (attr
, QCweight
)
4229 || EQ (attr
, QCslant
)
4230 || EQ (attr
, QCwidth
))
4232 /* Extract permissible symbols from tables. */
4233 struct table_entry
*table
;
4236 if (EQ (attr
, QCweight
))
4237 table
= weight_table
, dim
= DIM (weight_table
);
4238 else if (EQ (attr
, QCslant
))
4239 table
= slant_table
, dim
= DIM (slant_table
);
4241 table
= swidth_table
, dim
= DIM (swidth_table
);
4243 for (i
= 0; i
< dim
; ++i
)
4245 Lisp_Object symbol
= *table
[i
].symbol
;
4246 Lisp_Object tail
= result
;
4249 && !EQ (XCAR (tail
), symbol
))
4253 result
= Fcons (symbol
, result
);
4256 else if (EQ (attr
, QCunderline
))
4257 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4258 else if (EQ (attr
, QCoverline
))
4259 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4260 else if (EQ (attr
, QCstrike_through
))
4261 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4262 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4263 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4269 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4270 Sinternal_merge_in_global_face
, 2, 2, 0,
4271 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4273 Lisp_Object face
, frame
;
4275 Lisp_Object global_lface
, local_lface
;
4276 CHECK_LIVE_FRAME (frame
, 1);
4277 global_lface
= lface_from_face_name (NULL
, face
, 1);
4278 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4279 if (NILP (local_lface
))
4280 local_lface
= Finternal_make_lisp_face (face
, frame
);
4281 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4282 XVECTOR (local_lface
)->contents
);
4287 /* The following function is implemented for compatibility with 20.2.
4288 The function is used in x-resolve-fonts when it is asked to
4289 return fonts with the same size as the font of a face. This is
4290 done in fontset.el. */
4292 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4293 "Return the font name of face FACE, or nil if it is unspecified.\n\
4294 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4295 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4296 The font default for a face is either nil, or a list\n\
4297 of the form (bold), (italic) or (bold italic).\n\
4298 If FRAME is omitted or nil, use the selected frame.")
4300 Lisp_Object face
, frame
;
4304 Lisp_Object result
= Qnil
;
4305 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4307 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4308 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4309 result
= Fcons (Qbold
, result
);
4311 if (!NILP (LFACE_SLANT (lface
))
4312 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4313 result
= Fcons (Qitalic
, result
);
4319 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4320 int face_id
= lookup_named_face (f
, face
, 0);
4321 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4322 return build_string (face
->font_name
);
4327 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4328 all attributes are `equal'. Tries to be fast because this function
4329 is called quite often. */
4332 lface_equal_p (v1
, v2
)
4333 Lisp_Object
*v1
, *v2
;
4337 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4339 Lisp_Object a
= v1
[i
];
4340 Lisp_Object b
= v2
[i
];
4342 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4343 and the other is specified. */
4344 equal_p
= XTYPE (a
) == XTYPE (b
);
4353 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4354 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4355 XSTRING (a
)->size
) == 0);
4364 equal_p
= !NILP (Fequal (a
, b
));
4374 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4375 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4376 "True if FACE1 and FACE2 are equal.\n\
4377 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4378 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4379 If FRAME is omitted or nil, use the selected frame.")
4380 (face1
, face2
, frame
)
4381 Lisp_Object face1
, face2
, frame
;
4385 Lisp_Object lface1
, lface2
;
4390 /* Don't use check_x_frame here because this function is called
4391 before X frames exist. At that time, if FRAME is nil,
4392 selected_frame will be used which is the frame dumped with
4393 Emacs. That frame is not an X frame. */
4394 f
= frame_or_selected_frame (frame
, 2);
4396 lface1
= lface_from_face_name (NULL
, face1
, 1);
4397 lface2
= lface_from_face_name (NULL
, face2
, 1);
4398 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4399 XVECTOR (lface2
)->contents
);
4400 return equal_p
? Qt
: Qnil
;
4404 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4405 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4406 "True if FACE has no attribute specified.\n\
4407 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4408 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4409 If FRAME is omitted or nil, use the selected frame.")
4411 Lisp_Object face
, frame
;
4418 frame
= selected_frame
;
4419 CHECK_LIVE_FRAME (frame
, 0);
4423 lface
= lface_from_face_name (NULL
, face
, 1);
4425 lface
= lface_from_face_name (f
, face
, 1);
4427 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4428 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4431 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4435 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4437 "Return an alist of frame-local faces defined on FRAME.\n\
4438 For internal use only.")
4442 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4443 return f
->face_alist
;
4447 /* Return a hash code for Lisp string STRING with case ignored. Used
4448 below in computing a hash value for a Lisp face. */
4450 static INLINE
unsigned
4451 hash_string_case_insensitive (string
)
4456 xassert (STRINGP (string
));
4457 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4458 hash
= (hash
<< 1) ^ tolower (*s
);
4463 /* Return a hash code for face attribute vector V. */
4465 static INLINE
unsigned
4469 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4470 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4471 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4472 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4473 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4474 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4475 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4479 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4480 considering charsets/registries). They do if they specify the same
4481 family, point size, weight, width, slant, and fontset. Both LFACE1
4482 and LFACE2 must be fully-specified. */
4485 lface_same_font_attributes_p (lface1
, lface2
)
4486 Lisp_Object
*lface1
, *lface2
;
4488 xassert (lface_fully_specified_p (lface1
)
4489 && lface_fully_specified_p (lface2
));
4490 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4491 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4492 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4493 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4494 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4495 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4496 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4497 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4498 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4499 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4500 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4501 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4506 /***********************************************************************
4508 ***********************************************************************/
4510 /* Allocate and return a new realized face for Lisp face attribute
4513 static struct face
*
4514 make_realized_face (attr
)
4517 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4518 bzero (face
, sizeof *face
);
4519 face
->ascii_face
= face
;
4520 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4525 /* Free realized face FACE, including its X resources. FACE may
4529 free_realized_face (f
, face
)
4535 #ifdef HAVE_WINDOW_SYSTEM
4536 if (FRAME_WINDOW_P (f
))
4538 /* Free fontset of FACE if it is ASCII face. */
4539 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4540 free_face_fontset (f
, face
);
4543 x_free_gc (f
, face
->gc
);
4547 free_face_colors (f
, face
);
4548 x_destroy_bitmap (f
, face
->stipple
);
4550 #endif /* HAVE_WINDOW_SYSTEM */
4557 /* Prepare face FACE for subsequent display on frame F. This
4558 allocated GCs if they haven't been allocated yet or have been freed
4559 by clearing the face cache. */
4562 prepare_face_for_display (f
, face
)
4566 #ifdef HAVE_WINDOW_SYSTEM
4567 xassert (FRAME_WINDOW_P (f
));
4572 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4574 xgcv
.foreground
= face
->foreground
;
4575 xgcv
.background
= face
->background
;
4576 #ifdef HAVE_X_WINDOWS
4577 xgcv
.graphics_exposures
= False
;
4579 /* The font of FACE may be null if we couldn't load it. */
4582 #ifdef HAVE_X_WINDOWS
4583 xgcv
.font
= face
->font
->fid
;
4586 xgcv
.font
= face
->font
;
4592 #ifdef HAVE_X_WINDOWS
4595 xgcv
.fill_style
= FillOpaqueStippled
;
4596 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4597 mask
|= GCFillStyle
| GCStipple
;
4600 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4603 #endif /* HAVE_WINDOW_SYSTEM */
4607 /***********************************************************************
4609 ***********************************************************************/
4611 /* Return a new face cache for frame F. */
4613 static struct face_cache
*
4617 struct face_cache
*c
;
4620 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4621 bzero (c
, sizeof *c
);
4622 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4623 c
->buckets
= (struct face
**) xmalloc (size
);
4624 bzero (c
->buckets
, size
);
4626 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4632 /* Clear out all graphics contexts for all realized faces, except for
4633 the basic faces. This should be done from time to time just to avoid
4634 keeping too many graphics contexts that are no longer needed. */
4638 struct face_cache
*c
;
4640 if (c
&& FRAME_WINDOW_P (c
->f
))
4642 #ifdef HAVE_WINDOW_SYSTEM
4644 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4646 struct face
*face
= c
->faces_by_id
[i
];
4647 if (face
&& face
->gc
)
4649 x_free_gc (c
->f
, face
->gc
);
4653 #endif /* HAVE_WINDOW_SYSTEM */
4658 /* Free all realized faces in face cache C, including basic faces. C
4659 may be null. If faces are freed, make sure the frame's current
4660 matrix is marked invalid, so that a display caused by an expose
4661 event doesn't try to use faces we destroyed. */
4664 free_realized_faces (c
)
4665 struct face_cache
*c
;
4670 struct frame
*f
= c
->f
;
4672 for (i
= 0; i
< c
->used
; ++i
)
4674 free_realized_face (f
, c
->faces_by_id
[i
]);
4675 c
->faces_by_id
[i
] = NULL
;
4679 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4680 bzero (c
->buckets
, size
);
4682 /* Must do a thorough redisplay the next time. Mark current
4683 matrices as invalid because they will reference faces freed
4684 above. This function is also called when a frame is
4685 destroyed. In this case, the root window of F is nil. */
4686 if (WINDOWP (f
->root_window
))
4688 clear_current_matrices (f
);
4689 ++windows_or_buffers_changed
;
4695 /* Free all faces realized for multibyte characters on frame F that
4699 free_realized_multibyte_face (f
, fontset
)
4703 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4707 for (i
= 0; i
< cache
->used
; i
++)
4709 face
= cache
->faces_by_id
[i
];
4711 && face
!= face
->ascii_face
4712 && face
->fontset
== fontset
)
4714 uncache_face (cache
, face
);
4715 free_realized_face (f
, face
);
4718 if (WINDOWP (f
->root_window
))
4720 clear_current_matrices (f
);
4721 ++windows_or_buffers_changed
;
4726 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4727 This is done after attributes of a named face have been changed,
4728 because we can't tell which realized faces depend on that face. */
4731 free_all_realized_faces (frame
)
4737 FOR_EACH_FRAME (rest
, frame
)
4738 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4741 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4745 /* Free face cache C and faces in it, including their X resources. */
4749 struct face_cache
*c
;
4753 free_realized_faces (c
);
4755 xfree (c
->faces_by_id
);
4761 /* Cache realized face FACE in face cache C. HASH is the hash value
4762 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4763 collision list of the face hash table of C. This is done because
4764 otherwise lookup_face would find FACE for every character, even if
4765 faces with the same attributes but for specific characters exist. */
4768 cache_face (c
, face
, hash
)
4769 struct face_cache
*c
;
4773 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4777 if (face
->fontset
>= 0)
4779 struct face
*last
= c
->buckets
[i
];
4790 c
->buckets
[i
] = face
;
4791 face
->prev
= face
->next
= NULL
;
4797 face
->next
= c
->buckets
[i
];
4799 face
->next
->prev
= face
;
4800 c
->buckets
[i
] = face
;
4803 /* Find a free slot in C->faces_by_id and use the index of the free
4804 slot as FACE->id. */
4805 for (i
= 0; i
< c
->used
; ++i
)
4806 if (c
->faces_by_id
[i
] == NULL
)
4810 /* Maybe enlarge C->faces_by_id. */
4811 if (i
== c
->used
&& c
->used
== c
->size
)
4813 int new_size
= 2 * c
->size
;
4814 int sz
= new_size
* sizeof *c
->faces_by_id
;
4815 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4820 /* Check that FACE got a unique id. */
4825 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4826 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4832 #endif /* GLYPH_DEBUG */
4834 c
->faces_by_id
[i
] = face
;
4840 /* Remove face FACE from cache C. */
4843 uncache_face (c
, face
)
4844 struct face_cache
*c
;
4847 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4850 face
->prev
->next
= face
->next
;
4852 c
->buckets
[i
] = face
->next
;
4855 face
->next
->prev
= face
->prev
;
4857 c
->faces_by_id
[face
->id
] = NULL
;
4858 if (face
->id
== c
->used
)
4863 /* Look up a realized face with face attributes ATTR in the face cache
4864 of frame F. The face will be used to display character C. Value
4865 is the ID of the face found. If no suitable face is found, realize
4866 a new one. In that case, if C is a multibyte character, BASE_FACE
4867 is a face for ASCII characters that has the same attributes. */
4870 lookup_face (f
, attr
, c
, base_face
)
4874 struct face
*base_face
;
4876 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4881 xassert (cache
!= NULL
);
4882 check_lface_attrs (attr
);
4884 /* Look up ATTR in the face cache. */
4885 hash
= lface_hash (attr
);
4886 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4888 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4889 if (face
->hash
== hash
4890 && (!FRAME_WINDOW_P (f
)
4891 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
4892 && lface_equal_p (face
->lface
, attr
))
4895 /* If not found, realize a new face. */
4897 face
= realize_face (cache
, attr
, c
, base_face
, -1);
4900 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4902 /* When this function is called from face_for_char (in this case, C is
4903 a multibyte character), a fontset of a face returned by
4904 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
4905 C) is not sutisfied. The fontset is set for this face by
4906 face_for_char later. */
4908 if (FRAME_WINDOW_P (f
))
4909 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
4911 #endif /* GLYPH_DEBUG */
4917 /* Return the face id of the realized face for named face SYMBOL on
4918 frame F suitable for displaying character C. */
4921 lookup_named_face (f
, symbol
, c
)
4926 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4927 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4928 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4930 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4931 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4932 merge_face_vectors (symbol_attrs
, attrs
);
4933 return lookup_face (f
, attrs
, c
, NULL
);
4937 /* Return the ID of the realized ASCII face of Lisp face with ID
4938 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4941 ascii_face_of_lisp_face (f
, lface_id
)
4947 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4949 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4950 face_id
= lookup_named_face (f
, face_name
, 0);
4959 /* Return a face for charset ASCII that is like the face with id
4960 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4961 STEPS < 0 means larger. Value is the id of the face. */
4964 smaller_face (f
, face_id
, steps
)
4968 #ifdef HAVE_WINDOW_SYSTEM
4970 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4971 int pt
, last_pt
, last_height
;
4974 struct face
*new_face
;
4976 /* If not called for an X frame, just return the original face. */
4977 if (FRAME_TERMCAP_P (f
))
4980 /* Try in increments of 1/2 pt. */
4981 delta
= steps
< 0 ? 5 : -5;
4982 steps
= abs (steps
);
4984 face
= FACE_FROM_ID (f
, face_id
);
4985 bcopy (face
->lface
, attrs
, sizeof attrs
);
4986 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4987 new_face_id
= face_id
;
4988 last_height
= FONT_HEIGHT (face
->font
);
4992 /* Give up if we cannot find a font within 10pt. */
4993 && abs (last_pt
- pt
) < 100)
4995 /* Look up a face for a slightly smaller/larger font. */
4997 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4998 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
4999 new_face
= FACE_FROM_ID (f
, new_face_id
);
5001 /* If height changes, count that as one step. */
5002 if (FONT_HEIGHT (new_face
->font
) != last_height
)
5005 last_height
= FONT_HEIGHT (new_face
->font
);
5012 #else /* not HAVE_WINDOW_SYSTEM */
5016 #endif /* not HAVE_WINDOW_SYSTEM */
5020 /* Return a face for charset ASCII that is like the face with id
5021 FACE_ID on frame F, but has height HEIGHT. */
5024 face_with_height (f
, face_id
, height
)
5029 #ifdef HAVE_WINDOW_SYSTEM
5031 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5033 if (FRAME_TERMCAP_P (f
)
5037 face
= FACE_FROM_ID (f
, face_id
);
5038 bcopy (face
->lface
, attrs
, sizeof attrs
);
5039 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5040 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5041 #endif /* HAVE_WINDOW_SYSTEM */
5046 /* Return the face id of the realized face for named face SYMBOL on
5047 frame F suitable for displaying character C, and use attributes of
5048 the face FACE_ID for attributes that aren't completely specified by
5049 SYMBOL. This is like lookup_named_face, except that the default
5050 attributes come from FACE_ID, not from the default face. FACE_ID
5051 is assumed to be already realized. */
5054 lookup_derived_face (f
, symbol
, c
, face_id
)
5060 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5061 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5062 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5067 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5068 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5069 merge_face_vectors (symbol_attrs
, attrs
);
5070 return lookup_face (f
, attrs
, c
, default_face
);
5075 /***********************************************************************
5077 ***********************************************************************/
5079 DEFUN ("internal-set-font-selection-order",
5080 Finternal_set_font_selection_order
,
5081 Sinternal_set_font_selection_order
, 1, 1, 0,
5082 "Set font selection order for face font selection to ORDER.\n\
5083 ORDER must be a list of length 4 containing the symbols `:width',\n\
5084 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5085 first in ORDER are matched first, e.g. if `:height' appears before\n\
5086 `:weight' in ORDER, font selection first tries to find a font with\n\
5087 a suitable height, and then tries to match the font weight.\n\
5096 CHECK_LIST (order
, 0);
5097 bzero (indices
, sizeof indices
);
5101 CONSP (list
) && i
< DIM (indices
);
5102 list
= XCDR (list
), ++i
)
5104 Lisp_Object attr
= XCAR (list
);
5107 if (EQ (attr
, QCwidth
))
5109 else if (EQ (attr
, QCheight
))
5110 xlfd
= XLFD_POINT_SIZE
;
5111 else if (EQ (attr
, QCweight
))
5113 else if (EQ (attr
, QCslant
))
5118 if (indices
[i
] != 0)
5124 || i
!= DIM (indices
)
5129 signal_error ("Invalid font sort order", order
);
5131 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5133 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5134 free_all_realized_faces (Qnil
);
5141 DEFUN ("internal-set-alternative-font-family-alist",
5142 Finternal_set_alternative_font_family_alist
,
5143 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5144 "Define alternative font families to try in face font selection.\n\
5145 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5146 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5147 be found. Value is ALIST.")
5151 CHECK_LIST (alist
, 0);
5152 Vface_alternative_font_family_alist
= alist
;
5153 free_all_realized_faces (Qnil
);
5158 #ifdef HAVE_WINDOW_SYSTEM
5160 /* Value is non-zero if FONT is the name of a scalable font. The
5161 X11R6 XLFD spec says that point size, pixel size, and average width
5162 are zero for scalable fonts. Intlfonts contain at least one
5163 scalable font ("*-muleindian-1") for which this isn't true, so we
5164 just test average width. */
5167 font_scalable_p (font
)
5168 struct font_name
*font
;
5170 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5171 return (*s
== '0' && *(s
+ 1) == '\0')
5173 /* Windows implementation of XLFD is slightly broken for backward
5174 compatibility with previous broken versions, so test for
5175 wildcards as well as 0. */
5182 /* Value is non-zero if FONT1 is a better match for font attributes
5183 VALUES than FONT2. VALUES is an array of face attribute values in
5184 font sort order. COMPARE_PT_P zero means don't compare point
5188 better_font_p (values
, font1
, font2
, compare_pt_p
)
5190 struct font_name
*font1
, *font2
;
5195 for (i
= 0; i
< 4; ++i
)
5197 int xlfd_idx
= font_sort_order
[i
];
5199 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5201 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5202 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5204 if (delta1
> delta2
)
5206 else if (delta1
< delta2
)
5210 /* The difference may be equal because, e.g., the face
5211 specifies `italic' but we have only `regular' and
5212 `oblique'. Prefer `oblique' in this case. */
5213 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5214 && font1
->numeric
[xlfd_idx
] > values
[i
]
5215 && font2
->numeric
[xlfd_idx
] < values
[i
])
5227 /* Value is non-zero if FONT is an exact match for face attributes in
5228 SPECIFIED. SPECIFIED is an array of face attribute values in font
5232 exact_face_match_p (specified
, font
)
5234 struct font_name
*font
;
5238 for (i
= 0; i
< 4; ++i
)
5239 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5246 /* Value is the name of a scaled font, generated from scalable font
5247 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5248 Value is allocated from heap. */
5251 build_scalable_font_name (f
, font
, specified_pt
)
5253 struct font_name
*font
;
5256 char point_size
[20], pixel_size
[20];
5258 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5261 /* If scalable font is for a specific resolution, compute
5262 the point size we must specify from the resolution of
5263 the display and the specified resolution of the font. */
5264 if (font
->numeric
[XLFD_RESY
] != 0)
5266 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5267 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5272 pixel_value
= resy
/ 720.0 * pt
;
5275 /* Set point size of the font. */
5276 sprintf (point_size
, "%d", (int) pt
);
5277 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5278 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5280 /* Set pixel size. */
5281 sprintf (pixel_size
, "%d", pixel_value
);
5282 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5283 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5285 /* If font doesn't specify its resolution, use the
5286 resolution of the display. */
5287 if (font
->numeric
[XLFD_RESY
] == 0)
5290 sprintf (buffer
, "%d", (int) resy
);
5291 font
->fields
[XLFD_RESY
] = buffer
;
5292 font
->numeric
[XLFD_RESY
] = resy
;
5295 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5298 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5299 sprintf (buffer
, "%d", resx
);
5300 font
->fields
[XLFD_RESX
] = buffer
;
5301 font
->numeric
[XLFD_RESX
] = resx
;
5304 return build_font_name (font
);
5308 /* Value is non-zero if we are allowed to use scalable font FONT. We
5309 can't run a Lisp function here since this function may be called
5310 with input blocked. */
5313 may_use_scalable_font_p (font
, name
)
5314 struct font_name
*font
;
5317 if (EQ (Vscalable_fonts_allowed
, Qt
))
5319 else if (CONSP (Vscalable_fonts_allowed
))
5321 Lisp_Object tail
, regexp
;
5323 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5325 regexp
= XCAR (tail
);
5326 if (STRINGP (regexp
)
5327 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5335 #endif /* SCALABLE_FONTS != 0 */
5338 /* Return the name of the best matching font for face attributes
5339 ATTRS in the array of font_name structures FONTS which contains
5340 NFONTS elements. Value is a font name which is allocated from
5341 the heap. FONTS is freed by this function. */
5344 best_matching_font (f
, attrs
, fonts
, nfonts
)
5347 struct font_name
*fonts
;
5351 struct font_name
*best
;
5359 /* Make specified font attributes available in `specified',
5360 indexed by sort order. */
5361 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5363 int xlfd_idx
= font_sort_order
[i
];
5365 if (xlfd_idx
== XLFD_SWIDTH
)
5366 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5367 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5368 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5369 else if (xlfd_idx
== XLFD_WEIGHT
)
5370 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5371 else if (xlfd_idx
== XLFD_SLANT
)
5372 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5382 /* Start with the first non-scalable font in the list. */
5383 for (i
= 0; i
< nfonts
; ++i
)
5384 if (!font_scalable_p (fonts
+ i
))
5387 /* Find the best match among the non-scalable fonts. */
5392 for (i
= 1; i
< nfonts
; ++i
)
5393 if (!font_scalable_p (fonts
+ i
)
5394 && better_font_p (specified
, fonts
+ i
, best
, 1))
5398 exact_p
= exact_face_match_p (specified
, best
);
5407 /* Unless we found an exact match among non-scalable fonts, see if
5408 we can find a better match among scalable fonts. */
5411 /* A scalable font is better if
5413 1. its weight, slant, swidth attributes are better, or.
5415 2. the best non-scalable font doesn't have the required
5416 point size, and the scalable fonts weight, slant, swidth
5419 int non_scalable_has_exact_height_p
;
5421 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5422 non_scalable_has_exact_height_p
= 1;
5424 non_scalable_has_exact_height_p
= 0;
5426 for (i
= 0; i
< nfonts
; ++i
)
5427 if (font_scalable_p (fonts
+ i
))
5430 || better_font_p (specified
, fonts
+ i
, best
, 0)
5431 || (!non_scalable_has_exact_height_p
5432 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5437 if (font_scalable_p (best
))
5438 font_name
= build_scalable_font_name (f
, best
, pt
);
5440 font_name
= build_font_name (best
);
5442 #else /* !SCALABLE_FONTS */
5444 /* Find the best non-scalable font. */
5447 for (i
= 1; i
< nfonts
; ++i
)
5449 xassert (!font_scalable_p (fonts
+ i
));
5450 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5454 font_name
= build_font_name (best
);
5456 #endif /* !SCALABLE_FONTS */
5458 /* Free font_name structures. */
5459 free_font_names (fonts
, nfonts
);
5465 /* Try to get a list of fonts on frame F with font family FAMILY and
5466 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5467 of font_name structures for the fonts matched. Value is the number
5471 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5474 Lisp_Object pattern
, family
, registry
;
5475 struct font_name
**fonts
;
5479 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5480 family
= attrs
[LFACE_FAMILY_INDEX
];
5482 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5484 if (nfonts
== 0 && !NILP (family
))
5488 /* Try alternative font families from
5489 Vface_alternative_font_family_alist. */
5490 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5492 for (alter
= XCDR (alter
);
5493 CONSP (alter
) && nfonts
== 0;
5494 alter
= XCDR (alter
))
5496 if (STRINGP (XCAR (alter
)))
5497 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5500 /* Try font family of the default face or "fixed". */
5503 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5505 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5507 family
= build_string ("fixed");
5508 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5511 /* Try any family with the given registry. */
5513 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5520 /* Return the fontset id of the base fontset name or alias name given
5521 by the fontset attribute of ATTRS. Value is -1 if the fontset
5522 attribute of ATTRS doesn't name a fontset. */
5525 face_fontset (attrs
)
5531 name
= attrs
[LFACE_FONT_INDEX
];
5532 if (!STRINGP (name
))
5534 return fs_query_fontset (name
, 0);
5538 /* Choose a name of font to use on frame F to display character C with
5539 Lisp face attributes specified by ATTRS. The font name is
5540 determined by the font-related attributes in ATTRS and the name
5541 pattern for C in FONTSET. Value is the font name which is
5542 allocated from the heap and must be freed by the caller, or NULL if
5543 we can get no information about the font name of C. It is assured
5544 that we always get some information for a single byte
5548 choose_face_font (f
, attrs
, fontset
, c
)
5553 Lisp_Object pattern
;
5554 char *font_name
= NULL
;
5555 struct font_name
*fonts
;
5558 /* Get (foundry and) family name and registry (and encoding) name of
5560 pattern
= fontset_font_pattern (f
, fontset
, c
);
5563 xassert (!SINGLE_BYTE_CHAR_P (c
));
5566 /* If what we got is a name pattern, return it. */
5567 if (STRINGP (pattern
))
5568 return xstrdup (XSTRING (pattern
)->data
);
5570 /* Family name may be specified both in ATTRS and car part of
5571 PATTERN. The former has higher priority if C is a single byte
5573 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5574 && SINGLE_BYTE_CHAR_P (c
))
5575 XCAR (pattern
) = Qnil
;
5577 /* Get a list of fonts matching that pattern and choose the
5578 best match for the specified face attributes from it. */
5579 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
5581 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5585 #endif /* HAVE_WINDOW_SYSTEM */
5589 /***********************************************************************
5591 ***********************************************************************/
5593 /* Realize basic faces on frame F. Value is zero if frame parameters
5594 of F don't contain enough information needed to realize the default
5598 realize_basic_faces (f
)
5603 if (realize_default_face (f
))
5605 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5606 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5607 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5608 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5609 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5610 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5611 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5612 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5613 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5621 /* Realize the default face on frame F. If the face is not fully
5622 specified, make it fully-specified. Attributes of the default face
5623 that are not explicitly specified are taken from frame parameters. */
5626 realize_default_face (f
)
5629 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5631 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5632 Lisp_Object frame_font
;
5636 /* If the `default' face is not yet known, create it. */
5637 lface
= lface_from_face_name (f
, Qdefault
, 0);
5641 XSETFRAME (frame
, f
);
5642 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5645 #ifdef HAVE_WINDOW_SYSTEM
5646 if (FRAME_WINDOW_P (f
))
5648 /* Set frame_font to the value of the `font' frame parameter. */
5649 frame_font
= Fassq (Qfont
, f
->param_alist
);
5650 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5651 frame_font
= XCDR (frame_font
);
5652 set_lface_from_font_name (f
, lface
, frame_font
, 0, 1);
5654 #endif /* HAVE_WINDOW_SYSTEM */
5656 if (!FRAME_WINDOW_P (f
))
5658 LFACE_FAMILY (lface
) = build_string ("default");
5659 LFACE_SWIDTH (lface
) = Qnormal
;
5660 LFACE_HEIGHT (lface
) = make_number (1);
5661 LFACE_WEIGHT (lface
) = Qnormal
;
5662 LFACE_SLANT (lface
) = Qnormal
;
5665 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5666 LFACE_UNDERLINE (lface
) = Qnil
;
5668 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5669 LFACE_OVERLINE (lface
) = Qnil
;
5671 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5672 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5674 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5675 LFACE_BOX (lface
) = Qnil
;
5677 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5678 LFACE_INVERSE (lface
) = Qnil
;
5680 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5682 /* This function is called so early that colors are not yet
5683 set in the frame parameter list. */
5684 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5686 if (CONSP (color
) && STRINGP (XCDR (color
)))
5687 LFACE_FOREGROUND (lface
) = XCDR (color
);
5688 else if (FRAME_WINDOW_P (f
))
5690 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5691 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5696 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5698 /* This function is called so early that colors are not yet
5699 set in the frame parameter list. */
5700 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5701 if (CONSP (color
) && STRINGP (XCDR (color
)))
5702 LFACE_BACKGROUND (lface
) = XCDR (color
);
5703 else if (FRAME_WINDOW_P (f
))
5705 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5706 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5711 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5712 LFACE_STIPPLE (lface
) = Qnil
;
5714 /* Realize the face; it must be fully-specified now. */
5715 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5716 check_lface (lface
);
5717 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5718 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
5723 /* Realize basic faces other than the default face in face cache C.
5724 SYMBOL is the face name, ID is the face id the realized face must
5725 have. The default face must have been realized already. */
5728 realize_named_face (f
, symbol
, id
)
5733 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5734 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5735 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5736 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5737 struct face
*new_face
;
5739 /* The default face must exist and be fully specified. */
5740 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5741 check_lface_attrs (attrs
);
5742 xassert (lface_fully_specified_p (attrs
));
5744 /* If SYMBOL isn't know as a face, create it. */
5748 XSETFRAME (frame
, f
);
5749 lface
= Finternal_make_lisp_face (symbol
, frame
);
5752 /* Merge SYMBOL's face with the default face. */
5753 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5754 merge_face_vectors (symbol_attrs
, attrs
);
5756 /* Realize the face. */
5757 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
5761 /* Realize the fully-specified face with attributes ATTRS in face
5762 cache CACHE for character C. If C is a multibyte character,
5763 BASE_FACE is a face for ASCII characters that has the same
5764 attributes. Otherwise, BASE_FACE is ignored. If FORMER_FACE_ID is
5765 non-negative, it is an ID of face to remove before caching the new
5766 face. Value is a pointer to the newly created realized face. */
5768 static struct face
*
5769 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
5770 struct face_cache
*cache
;
5773 struct face
*base_face
;
5778 /* LFACE must be fully specified. */
5779 xassert (cache
!= NULL
);
5780 check_lface_attrs (attrs
);
5782 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5784 /* Remove the former face. */
5785 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5786 uncache_face (cache
, former_face
);
5787 free_realized_face (cache
->f
, former_face
);
5790 if (FRAME_WINDOW_P (cache
->f
))
5791 face
= realize_x_face (cache
, attrs
, c
, base_face
);
5792 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5793 face
= realize_tty_face (cache
, attrs
, c
);
5797 /* Insert the new face. */
5798 cache_face (cache
, face
, lface_hash (attrs
));
5799 #ifdef HAVE_WINDOW_SYSTEM
5800 if (FRAME_X_P (cache
->f
) && face
->font
== NULL
)
5801 load_face_font (cache
->f
, face
, c
);
5802 #endif /* HAVE_WINDOW_SYSTEM */
5807 /* Realize the fully-specified face with attributes ATTRS in face
5808 cache CACHE for character C. Do it for X frame CACHE->f. If C is
5809 a multibyte character, BASE_FACE is a face for ASCII characters
5810 that has the same attributes. Otherwise, BASE_FACE is ignored. If
5811 the new face doesn't share font with the default face, a fontname
5812 is allocated from the heap and set in `font_name' of the new face,
5813 but it is not yet loaded here. Value is a pointer to the newly
5814 created realized face. */
5816 static struct face
*
5817 realize_x_face (cache
, attrs
, c
, base_face
)
5818 struct face_cache
*cache
;
5821 struct face
*base_face
;
5823 #ifdef HAVE_WINDOW_SYSTEM
5824 struct face
*face
, *default_face
;
5826 Lisp_Object stipple
, overline
, strike_through
, box
;
5828 xassert (FRAME_WINDOW_P (cache
->f
));
5829 xassert (SINGLE_BYTE_CHAR_P (c
)
5830 || (base_face
&& base_face
->ascii_face
== base_face
));
5832 /* Allocate a new realized face. */
5833 face
= make_realized_face (attrs
);
5837 /* If C is a multibyte character, we share all face attirbutes with
5838 BASE_FACE including the realized fontset. But, we must load a
5840 if (!SINGLE_BYTE_CHAR_P (c
))
5842 bcopy (base_face
, face
, sizeof *face
);
5844 face
->font
= NULL
; /* to force realize_face to load font */
5848 /* Now we are realizing a face for ASCII (and unibyte) characters. */
5850 /* Determine the font to use. Most of the time, the font will be
5851 the same as the font of the default face, so try that first. */
5852 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5854 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
5855 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5857 face
->font
= default_face
->font
;
5858 face
->fontset
= default_face
->fontset
;
5859 face
->font_info_id
= default_face
->font_info_id
;
5860 face
->font_name
= default_face
->font_name
;
5861 face
->ascii_face
= face
;
5863 /* But, as we can't share the fontset, make a new realized
5864 fontset that has the same base fontset as of the default
5867 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
5871 /* If the face attribute ATTRS specifies a fontset, use it as
5872 the base of a new realized fontset. Otherwise, use the
5873 default fontset as the base. The base determines registry
5874 and encoding of a font. It may also determine foundry and
5875 family. The other fields of font name pattern are
5876 constructed from ATTRS. */
5878 = make_fontset_for_ascii_face (f
, face_fontset (attrs
));
5879 face
->font
= NULL
; /* to force realize_face to load font */
5882 /* Load colors, and set remaining attributes. */
5884 load_face_colors (f
, face
, attrs
);
5887 box
= attrs
[LFACE_BOX_INDEX
];
5890 /* A simple box of line width 1 drawn in color given by
5892 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5894 face
->box
= FACE_SIMPLE_BOX
;
5895 face
->box_line_width
= 1;
5897 else if (INTEGERP (box
))
5899 /* Simple box of specified line width in foreground color of the
5901 xassert (XINT (box
) > 0);
5902 face
->box
= FACE_SIMPLE_BOX
;
5903 face
->box_line_width
= XFASTINT (box
);
5904 face
->box_color
= face
->foreground
;
5905 face
->box_color_defaulted_p
= 1;
5907 else if (CONSP (box
))
5909 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5910 being one of `raised' or `sunken'. */
5911 face
->box
= FACE_SIMPLE_BOX
;
5912 face
->box_color
= face
->foreground
;
5913 face
->box_color_defaulted_p
= 1;
5914 face
->box_line_width
= 1;
5918 Lisp_Object keyword
, value
;
5920 keyword
= XCAR (box
);
5928 if (EQ (keyword
, QCline_width
))
5930 if (INTEGERP (value
) && XINT (value
) > 0)
5931 face
->box_line_width
= XFASTINT (value
);
5933 else if (EQ (keyword
, QCcolor
))
5935 if (STRINGP (value
))
5937 face
->box_color
= load_color (f
, face
, value
,
5939 face
->use_box_color_for_shadows_p
= 1;
5942 else if (EQ (keyword
, QCstyle
))
5944 if (EQ (value
, Qreleased_button
))
5945 face
->box
= FACE_RAISED_BOX
;
5946 else if (EQ (value
, Qpressed_button
))
5947 face
->box
= FACE_SUNKEN_BOX
;
5952 /* Text underline, overline, strike-through. */
5954 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5956 /* Use default color (same as foreground color). */
5957 face
->underline_p
= 1;
5958 face
->underline_defaulted_p
= 1;
5959 face
->underline_color
= 0;
5961 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5963 /* Use specified color. */
5964 face
->underline_p
= 1;
5965 face
->underline_defaulted_p
= 0;
5966 face
->underline_color
5967 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5968 LFACE_UNDERLINE_INDEX
);
5970 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5972 face
->underline_p
= 0;
5973 face
->underline_defaulted_p
= 0;
5974 face
->underline_color
= 0;
5977 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5978 if (STRINGP (overline
))
5980 face
->overline_color
5981 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5982 LFACE_OVERLINE_INDEX
);
5983 face
->overline_p
= 1;
5985 else if (EQ (overline
, Qt
))
5987 face
->overline_color
= face
->foreground
;
5988 face
->overline_color_defaulted_p
= 1;
5989 face
->overline_p
= 1;
5992 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5993 if (STRINGP (strike_through
))
5995 face
->strike_through_color
5996 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5997 LFACE_STRIKE_THROUGH_INDEX
);
5998 face
->strike_through_p
= 1;
6000 else if (EQ (strike_through
, Qt
))
6002 face
->strike_through_color
= face
->foreground
;
6003 face
->strike_through_color_defaulted_p
= 1;
6004 face
->strike_through_p
= 1;
6007 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6008 if (!NILP (stipple
))
6009 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6011 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6013 #endif /* HAVE_WINDOW_SYSTEM */
6017 /* Realize the fully-specified face with attributes ATTRS in face
6018 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6019 pointer to the newly created realized face. */
6021 static struct face
*
6022 realize_tty_face (cache
, attrs
, c
)
6023 struct face_cache
*cache
;
6030 Lisp_Object tty_defined_color_alist
=
6031 Fsymbol_value (intern ("tty-defined-color-alist"));
6032 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6034 int face_colors_defaulted
= 0;
6036 /* Frame must be a termcap frame. */
6037 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6039 /* Allocate a new realized face. */
6040 face
= make_realized_face (attrs
);
6041 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6043 /* Map face attributes to TTY appearances. We map slant to
6044 dimmed text because we want italic text to appear differently
6045 and because dimmed text is probably used infrequently. */
6046 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6047 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6049 if (weight
> XLFD_WEIGHT_MEDIUM
)
6050 face
->tty_bold_p
= 1;
6051 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6052 face
->tty_dim_p
= 1;
6053 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6054 face
->tty_underline_p
= 1;
6055 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6056 face
->tty_reverse_p
= 1;
6058 /* Map color names to color indices. */
6059 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6060 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6062 XSETFRAME (frame
, cache
->f
);
6063 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6065 && XSTRING (color
)->size
6066 && !NILP (tty_defined_color_alist
)
6067 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6069 /* Associations in tty-defined-color-alist are of the form
6070 (NAME INDEX R G B). We need the INDEX part. */
6071 face
->foreground
= XINT (XCAR (XCDR (color
)));
6073 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6074 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6076 face
->foreground
= load_color (cache
->f
, face
,
6077 attrs
[LFACE_FOREGROUND_INDEX
],
6078 LFACE_FOREGROUND_INDEX
);
6080 #if defined (MSDOS) || defined (WINDOWSNT)
6081 /* If the foreground of the default face is the default color,
6082 use the foreground color defined by the frame. */
6084 if (FRAME_MSDOS_P (cache
->f
))
6088 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6089 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6091 face
->foreground
= FRAME_FOREGROUND_PIXEL (cache
->f
);
6092 attrs
[LFACE_FOREGROUND_INDEX
] =
6093 tty_color_name (cache
->f
, face
->foreground
);
6094 face_colors_defaulted
= 1;
6096 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6098 face
->foreground
= FRAME_BACKGROUND_PIXEL (cache
->f
);
6099 attrs
[LFACE_FOREGROUND_INDEX
] =
6100 tty_color_name (cache
->f
, face
->foreground
);
6101 face_colors_defaulted
= 1;
6106 #endif /* MSDOS or WINDOWSNT */
6109 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6111 && XSTRING (color
)->size
6112 && !NILP (tty_defined_color_alist
)
6113 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6115 /* Associations in tty-defined-color-alist are of the form
6116 (NAME INDEX R G B). We need the INDEX part. */
6117 face
->background
= XINT (XCAR (XCDR (color
)));
6119 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6120 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6122 face
->background
= load_color (cache
->f
, face
,
6123 attrs
[LFACE_BACKGROUND_INDEX
],
6124 LFACE_BACKGROUND_INDEX
);
6125 #if defined (MSDOS) || defined (WINDOWSNT)
6126 /* If the background of the default face is the default color,
6127 use the background color defined by the frame. */
6129 if (FRAME_MSDOS_P (cache
->f
))
6133 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6134 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6136 face
->background
= FRAME_BACKGROUND_PIXEL (cache
->f
);
6137 attrs
[LFACE_BACKGROUND_INDEX
] =
6138 tty_color_name (cache
->f
, face
->background
);
6139 face_colors_defaulted
= 1;
6141 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6143 face
->background
= FRAME_FOREGROUND_PIXEL (cache
->f
);
6144 attrs
[LFACE_BACKGROUND_INDEX
] =
6145 tty_color_name (cache
->f
, face
->background
);
6146 face_colors_defaulted
= 1;
6151 #endif /* MSDOS or WINDOWSNT */
6154 /* Swap colors if face is inverse-video. If the colors are taken
6155 from the frame colors, they are already inverted, since the
6156 frame-creation function calls x-handle-reverse-video. */
6157 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6159 unsigned long tem
= face
->foreground
;
6161 face
->foreground
= face
->background
;
6162 face
->background
= tem
;
6170 /***********************************************************************
6172 ***********************************************************************/
6174 /* Return the ID of the face to use to display character CH with face
6175 property PROP on frame F in current_buffer. */
6178 compute_char_face (f
, ch
, prop
)
6185 if (NILP (current_buffer
->enable_multibyte_characters
))
6190 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6191 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6195 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6196 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6197 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6198 merge_face_vector_with_property (f
, attrs
, prop
);
6199 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6206 /* Return the face ID associated with buffer position POS for
6207 displaying ASCII characters. Return in *ENDPTR the position at
6208 which a different face is needed, as far as text properties and
6209 overlays are concerned. W is a window displaying current_buffer.
6211 REGION_BEG, REGION_END delimit the region, so it can be
6214 LIMIT is a position not to scan beyond. That is to limit the time
6215 this function can take.
6217 If MOUSE is non-zero, use the character's mouse-face, not its face.
6219 The face returned is suitable for displaying ASCII characters. */
6222 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6223 endptr
, limit
, mouse
)
6226 int region_beg
, region_end
;
6231 struct frame
*f
= XFRAME (w
->frame
);
6232 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6233 Lisp_Object prop
, position
;
6235 Lisp_Object
*overlay_vec
;
6238 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6239 Lisp_Object limit1
, end
;
6240 struct face
*default_face
;
6241 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6243 /* W must display the current buffer. We could write this function
6244 to use the frame and buffer of W, but right now it doesn't. */
6245 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6247 XSETFRAME (frame
, f
);
6248 XSETFASTINT (position
, pos
);
6251 if (pos
< region_beg
&& region_beg
< endpos
)
6252 endpos
= region_beg
;
6254 /* Get the `face' or `mouse_face' text property at POS, and
6255 determine the next position at which the property changes. */
6256 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6257 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6258 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6260 endpos
= XINT (end
);
6262 /* Look at properties from overlays. */
6267 /* First try with room for 40 overlays. */
6269 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6270 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6271 &next_overlay
, NULL
);
6273 /* If there are more than 40, make enough space for all, and try
6275 if (noverlays
> len
)
6278 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6279 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6280 &next_overlay
, NULL
);
6283 if (next_overlay
< endpos
)
6284 endpos
= next_overlay
;
6289 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6291 /* Optimize common cases where we can use the default face. */
6294 && !(pos
>= region_beg
&& pos
< region_end
))
6295 return DEFAULT_FACE_ID
;
6297 /* Begin with attributes from the default face. */
6298 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6300 /* Merge in attributes specified via text properties. */
6302 merge_face_vector_with_property (f
, attrs
, prop
);
6304 /* Now merge the overlay data. */
6305 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6306 for (i
= 0; i
< noverlays
; i
++)
6311 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6313 merge_face_vector_with_property (f
, attrs
, prop
);
6315 oend
= OVERLAY_END (overlay_vec
[i
]);
6316 oendpos
= OVERLAY_POSITION (oend
);
6317 if (oendpos
< endpos
)
6321 /* If in the region, merge in the region face. */
6322 if (pos
>= region_beg
&& pos
< region_end
)
6324 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6325 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6327 if (region_end
< endpos
)
6328 endpos
= region_end
;
6333 /* Look up a realized face with the given face attributes,
6334 or realize a new one for ASCII characters. */
6335 return lookup_face (f
, attrs
, 0, NULL
);
6339 /* Compute the face at character position POS in Lisp string STRING on
6340 window W, for ASCII characters.
6342 If STRING is an overlay string, it comes from position BUFPOS in
6343 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6344 not an overlay string. W must display the current buffer.
6345 REGION_BEG and REGION_END give the start and end positions of the
6346 region; both are -1 if no region is visible. BASE_FACE_ID is the
6347 id of the basic face to merge with. It is usually equal to
6348 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6349 for strings displayed in the mode or top line.
6351 Set *ENDPTR to the next position where to check for faces in
6352 STRING; -1 if the face is constant from POS to the end of the
6355 Value is the id of the face to use. The face returned is suitable
6356 for displaying ASCII characters. */
6359 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6360 region_end
, endptr
, base_face_id
)
6364 int region_beg
, region_end
;
6366 enum face_id base_face_id
;
6368 Lisp_Object prop
, position
, end
, limit
;
6369 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6370 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6371 struct face
*base_face
;
6372 int multibyte_p
= STRING_MULTIBYTE (string
);
6374 /* Get the value of the face property at the current position within
6375 STRING. Value is nil if there is no face property. */
6376 XSETFASTINT (position
, pos
);
6377 prop
= Fget_text_property (position
, Qface
, string
);
6379 /* Get the next position at which to check for faces. Value of end
6380 is nil if face is constant all the way to the end of the string.
6381 Otherwise it is a string position where to check faces next.
6382 Limit is the maximum position up to which to check for property
6383 changes in Fnext_single_property_change. Strings are usually
6384 short, so set the limit to the end of the string. */
6385 XSETFASTINT (limit
, XSTRING (string
)->size
);
6386 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6388 *endptr
= XFASTINT (end
);
6392 base_face
= FACE_FROM_ID (f
, base_face_id
);
6393 xassert (base_face
);
6395 /* Optimize the default case that there is no face property and we
6396 are not in the region. */
6398 && (base_face_id
!= DEFAULT_FACE_ID
6399 /* BUFPOS <= 0 means STRING is not an overlay string, so
6400 that the region doesn't have to be taken into account. */
6402 || bufpos
< region_beg
6403 || bufpos
>= region_end
)
6405 /* We can't realize faces for different charsets differently
6406 if we don't have fonts, so we can stop here if not working
6407 on a window-system frame. */
6408 || !FRAME_WINDOW_P (f
)
6409 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6410 return base_face
->id
;
6412 /* Begin with attributes from the base face. */
6413 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6415 /* Merge in attributes specified via text properties. */
6417 merge_face_vector_with_property (f
, attrs
, prop
);
6419 /* If in the region, merge in the region face. */
6421 && bufpos
>= region_beg
6422 && bufpos
< region_end
)
6424 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6425 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6428 /* Look up a realized face with the given face attributes,
6429 or realize a new one for ASCII characters. */
6430 return lookup_face (f
, attrs
, 0, NULL
);
6435 /***********************************************************************
6437 ***********************************************************************/
6441 /* Print the contents of the realized face FACE to stderr. */
6444 dump_realized_face (face
)
6447 fprintf (stderr
, "ID: %d\n", face
->id
);
6448 #ifdef HAVE_X_WINDOWS
6449 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6451 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6453 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6454 fprintf (stderr
, "background: 0x%lx (%s)\n",
6456 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6457 fprintf (stderr
, "font_name: %s (%s)\n",
6459 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6460 #ifdef HAVE_X_WINDOWS
6461 fprintf (stderr
, "font = %p\n", face
->font
);
6463 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6464 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6465 fprintf (stderr
, "underline: %d (%s)\n",
6467 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6468 fprintf (stderr
, "hash: %d\n", face
->hash
);
6469 fprintf (stderr
, "charset: %d\n", face
->charset
);
6473 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6481 fprintf (stderr
, "font selection order: ");
6482 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6483 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6484 fprintf (stderr
, "\n");
6486 fprintf (stderr
, "alternative fonts: ");
6487 debug_print (Vface_alternative_font_family_alist
);
6488 fprintf (stderr
, "\n");
6490 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6491 Fdump_face (make_number (i
));
6496 CHECK_NUMBER (n
, 0);
6497 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6499 error ("Not a valid face");
6500 dump_realized_face (face
);
6507 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6511 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6512 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6513 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6517 #endif /* GLYPH_DEBUG != 0 */
6521 /***********************************************************************
6523 ***********************************************************************/
6528 Qface
= intern ("face");
6530 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6531 staticpro (&Qbitmap_spec_p
);
6532 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6533 staticpro (&Qframe_update_face_colors
);
6535 /* Lisp face attribute keywords. */
6536 QCfamily
= intern (":family");
6537 staticpro (&QCfamily
);
6538 QCheight
= intern (":height");
6539 staticpro (&QCheight
);
6540 QCweight
= intern (":weight");
6541 staticpro (&QCweight
);
6542 QCslant
= intern (":slant");
6543 staticpro (&QCslant
);
6544 QCunderline
= intern (":underline");
6545 staticpro (&QCunderline
);
6546 QCinverse_video
= intern (":inverse-video");
6547 staticpro (&QCinverse_video
);
6548 QCreverse_video
= intern (":reverse-video");
6549 staticpro (&QCreverse_video
);
6550 QCforeground
= intern (":foreground");
6551 staticpro (&QCforeground
);
6552 QCbackground
= intern (":background");
6553 staticpro (&QCbackground
);
6554 QCstipple
= intern (":stipple");;
6555 staticpro (&QCstipple
);
6556 QCwidth
= intern (":width");
6557 staticpro (&QCwidth
);
6558 QCfont
= intern (":font");
6559 staticpro (&QCfont
);
6560 QCbold
= intern (":bold");
6561 staticpro (&QCbold
);
6562 QCitalic
= intern (":italic");
6563 staticpro (&QCitalic
);
6564 QCoverline
= intern (":overline");
6565 staticpro (&QCoverline
);
6566 QCstrike_through
= intern (":strike-through");
6567 staticpro (&QCstrike_through
);
6568 QCbox
= intern (":box");
6571 /* Symbols used for Lisp face attribute values. */
6572 QCcolor
= intern (":color");
6573 staticpro (&QCcolor
);
6574 QCline_width
= intern (":line-width");
6575 staticpro (&QCline_width
);
6576 QCstyle
= intern (":style");
6577 staticpro (&QCstyle
);
6578 Qreleased_button
= intern ("released-button");
6579 staticpro (&Qreleased_button
);
6580 Qpressed_button
= intern ("pressed-button");
6581 staticpro (&Qpressed_button
);
6582 Qnormal
= intern ("normal");
6583 staticpro (&Qnormal
);
6584 Qultra_light
= intern ("ultra-light");
6585 staticpro (&Qultra_light
);
6586 Qextra_light
= intern ("extra-light");
6587 staticpro (&Qextra_light
);
6588 Qlight
= intern ("light");
6589 staticpro (&Qlight
);
6590 Qsemi_light
= intern ("semi-light");
6591 staticpro (&Qsemi_light
);
6592 Qsemi_bold
= intern ("semi-bold");
6593 staticpro (&Qsemi_bold
);
6594 Qbold
= intern ("bold");
6596 Qextra_bold
= intern ("extra-bold");
6597 staticpro (&Qextra_bold
);
6598 Qultra_bold
= intern ("ultra-bold");
6599 staticpro (&Qultra_bold
);
6600 Qoblique
= intern ("oblique");
6601 staticpro (&Qoblique
);
6602 Qitalic
= intern ("italic");
6603 staticpro (&Qitalic
);
6604 Qreverse_oblique
= intern ("reverse-oblique");
6605 staticpro (&Qreverse_oblique
);
6606 Qreverse_italic
= intern ("reverse-italic");
6607 staticpro (&Qreverse_italic
);
6608 Qultra_condensed
= intern ("ultra-condensed");
6609 staticpro (&Qultra_condensed
);
6610 Qextra_condensed
= intern ("extra-condensed");
6611 staticpro (&Qextra_condensed
);
6612 Qcondensed
= intern ("condensed");
6613 staticpro (&Qcondensed
);
6614 Qsemi_condensed
= intern ("semi-condensed");
6615 staticpro (&Qsemi_condensed
);
6616 Qsemi_expanded
= intern ("semi-expanded");
6617 staticpro (&Qsemi_expanded
);
6618 Qexpanded
= intern ("expanded");
6619 staticpro (&Qexpanded
);
6620 Qextra_expanded
= intern ("extra-expanded");
6621 staticpro (&Qextra_expanded
);
6622 Qultra_expanded
= intern ("ultra-expanded");
6623 staticpro (&Qultra_expanded
);
6624 Qbackground_color
= intern ("background-color");
6625 staticpro (&Qbackground_color
);
6626 Qforeground_color
= intern ("foreground-color");
6627 staticpro (&Qforeground_color
);
6628 Qunspecified
= intern ("unspecified");
6629 staticpro (&Qunspecified
);
6631 Qface_alias
= intern ("face-alias");
6632 staticpro (&Qface_alias
);
6633 Qdefault
= intern ("default");
6634 staticpro (&Qdefault
);
6635 Qtool_bar
= intern ("tool-bar");
6636 staticpro (&Qtool_bar
);
6637 Qregion
= intern ("region");
6638 staticpro (&Qregion
);
6639 Qfringe
= intern ("fringe");
6640 staticpro (&Qfringe
);
6641 Qheader_line
= intern ("header-line");
6642 staticpro (&Qheader_line
);
6643 Qscroll_bar
= intern ("scroll-bar");
6644 staticpro (&Qscroll_bar
);
6645 Qmenu
= intern ("menu");
6647 Qcursor
= intern ("cursor");
6648 staticpro (&Qcursor
);
6649 Qborder
= intern ("border");
6650 staticpro (&Qborder
);
6651 Qmouse
= intern ("mouse");
6652 staticpro (&Qmouse
);
6653 Qtty_color_desc
= intern ("tty-color-desc");
6654 staticpro (&Qtty_color_desc
);
6655 Qtty_color_by_index
= intern ("tty-color-by-index");
6656 staticpro (&Qtty_color_by_index
);
6658 defsubr (&Sinternal_make_lisp_face
);
6659 defsubr (&Sinternal_lisp_face_p
);
6660 defsubr (&Sinternal_set_lisp_face_attribute
);
6661 #ifdef HAVE_WINDOW_SYSTEM
6662 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6664 defsubr (&Scolor_gray_p
);
6665 defsubr (&Scolor_supported_p
);
6666 defsubr (&Sinternal_get_lisp_face_attribute
);
6667 defsubr (&Sinternal_lisp_face_attribute_values
);
6668 defsubr (&Sinternal_lisp_face_equal_p
);
6669 defsubr (&Sinternal_lisp_face_empty_p
);
6670 defsubr (&Sinternal_copy_lisp_face
);
6671 defsubr (&Sinternal_merge_in_global_face
);
6672 defsubr (&Sface_font
);
6673 defsubr (&Sframe_face_alist
);
6674 defsubr (&Sinternal_set_font_selection_order
);
6675 defsubr (&Sinternal_set_alternative_font_family_alist
);
6677 defsubr (&Sdump_face
);
6678 defsubr (&Sshow_face_resources
);
6679 #endif /* GLYPH_DEBUG */
6680 defsubr (&Sclear_face_cache
);
6682 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6683 "*Limit for font matching.\n\
6684 If an integer > 0, font matching functions won't load more than\n\
6685 that number of fonts when searching for a matching font.");
6686 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6688 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6689 "List of global face definitions (for internal use only.)");
6690 Vface_new_frame_defaults
= Qnil
;
6692 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6693 "*Default stipple pattern used on monochrome displays.\n\
6694 This stipple pattern is used on monochrome displays\n\
6695 instead of shades of gray for a face background color.\n\
6696 See `set-face-stipple' for possible values for this variable.");
6697 Vface_default_stipple
= build_string ("gray3");
6699 DEFVAR_LISP ("face-alternative-font-family-alist",
6700 &Vface_alternative_font_family_alist
, "");
6701 Vface_alternative_font_family_alist
= Qnil
;
6705 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6706 "Allowed scalable fonts.\n\
6707 A value of nil means don't allow any scalable fonts.\n\
6708 A value of t means allow any scalable font.\n\
6709 Otherwise, value must be a list of regular expressions. A font may be\n\
6710 scaled if its name matches a regular expression in the list.");
6712 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
6713 by default limits the fonts available severely. */
6714 Vscalable_fonts_allowed
= Qt
;
6716 Vscalable_fonts_allowed
= Qnil
;
6718 #endif /* SCALABLE_FONTS */
6720 #ifdef HAVE_WINDOW_SYSTEM
6721 defsubr (&Sbitmap_spec_p
);
6722 defsubr (&Sx_list_fonts
);
6723 defsubr (&Sinternal_face_x_get_resource
);
6724 defsubr (&Sx_family_fonts
);
6725 defsubr (&Sx_font_family_list
);
6726 #endif /* HAVE_WINDOW_SYSTEM */