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
29 1. Font family or fontset alias name.
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 Faces are frame-local by nature because Emacs allows to define the
59 same named face (face names are symbols) differently for different
60 frames. Each frame has an alist of face definitions for all named
61 faces. The value of a named face in such an alist is a Lisp vector
62 with the symbol `face' in slot 0, and a slot for each each of the
63 face attributes mentioned above.
65 There is also a global face alist `Vface_new_frame_defaults'. Face
66 definitions from this list are used to initialize faces of newly
69 A face doesn't have to specify all attributes. Those not specified
70 have a value of `unspecified'. Faces specifying all attributes are
71 called `fully-specified'.
76 The display style of a given character in the text is determined by
77 combining several faces. This process is called `face merging'.
78 Any aspect of the display style that isn't specified by overlays or
79 text properties is taken from the `default' face. Since it is made
80 sure that the default face is always fully-specified, face merging
81 always results in a fully-specified face.
86 After all face attributes for a character have been determined by
87 merging faces of that character, that face is `realized'. The
88 realization process maps face attributes to what is physically
89 available on the system where Emacs runs. The result is a
90 `realized face' in form of a struct face which is stored in the
91 face cache of the frame on which it was realized.
93 Face realization is done in the context of the charset of the
94 character to display because different fonts and encodings are used
95 for different charsets. In other words, for characters of
96 different charsets, different realized faces are needed to display
99 Faces are always realized for a specific character set and contain
100 a specific font, even if the face being realized specifies a
101 fontset (see `font selection' below). The reason is that the
102 result of the new font selection stage is better than what can be
103 done with statically defined font name patterns in fontsets.
108 In unibyte text, Emacs' charsets aren't applicable; function
109 `char-charset' reports CHARSET_ASCII for all characters, including
110 those > 0x7f. The X registry and encoding of fonts to use is
111 determined from the variable `x-unibyte-registry-and-encoding' in
112 this case. The variable is initialized at Emacs startup time from
113 the font the user specified for Emacs.
115 Currently all unibyte text, i.e. all buffers with
116 enable_multibyte_characters nil are displayed with fonts of the
117 same registry and encoding `x-unibyte-registry-and-encoding'. This
118 is consistent with the fact that languages can also be set
124 Font selection tries to find the best available matching font for a
125 given (charset, face) combination. This is done slightly
126 differently for faces specifying a fontset, or a font family name.
128 If the face specifies a fontset alias name, that fontset determines
129 a pattern for fonts of the given charset. If the face specifies a
130 font family, a font pattern is constructed. Charset symbols have a
131 property `x-charset-registry' for that purpose that maps a charset
132 to an XLFD registry and encoding in the font pattern constructed.
134 Available fonts on the system on which Emacs runs are then matched
135 against the font pattern. The result of font selection is the best
136 match for the given face attributes in this font list.
138 Font selection can be influenced by the user.
140 1. The user can specify the relative importance he gives the face
141 attributes width, height, weight, and slant by setting
142 face-font-selection-order (faces.el) to a list of face attribute
143 names. The default is '(:width :height :weight :slant), and means
144 that font selection first tries to find a good match for the font
145 width specified by a face, then---within fonts with that
146 width---tries to find a best match for the specified font height,
149 2. Setting face-alternative-font-family-alist allows the user to
150 specify alternative font families to try if a family specified by a
154 Composite characters.
156 Realized faces for composite characters are the only ones having a
157 fontset id >= 0. When a composite character is encoded into a
158 sequence of non-composite characters (in xterm.c), a suitable font
159 for the non-composite characters is then selected and realized,
160 i.e. the realization process is delayed but in principle the same.
163 Initialization of basic faces.
165 The faces `default', `modeline' are considered `basic faces'.
166 When redisplay happens the first time for a newly created frame,
167 basic faces are realized for CHARSET_ASCII. Frame parameters are
168 used to fill in unspecified attributes of the default face. */
170 /* Define SCALABLE_FONTS to a non-zero value to enable scalable
171 font use. Define it to zero to disable scalable font use.
173 Use of too many or too large scalable fonts can crash XFree86
174 servers. That's why I've put the code dealing with scalable fonts
177 #define SCALABLE_FONTS 1
180 #include <sys/types.h>
181 #include <sys/stat.h>
186 #ifdef HAVE_X_WINDOWS
191 #include <Xm/XmStrDefs.h>
192 #endif /* USE_MOTIF */
200 #include "dispextern.h"
201 #include "blockinput.h"
203 #include "intervals.h"
205 #ifdef HAVE_X_WINDOWS
207 /* Compensate for a bug in Xos.h on some systems, on which it requires
208 time.h. On some such systems, Xos.h tries to redefine struct
209 timeval and struct timezone if USG is #defined while it is
212 #ifdef XOS_NEEDS_TIME_H
218 #else /* not XOS_NEEDS_TIME_H */
220 #endif /* not XOS_NEEDS_TIME_H */
222 #endif /* HAVE_X_WINDOWS */
226 #include "keyboard.h"
229 #define max(A, B) ((A) > (B) ? (A) : (B))
230 #define min(A, B) ((A) < (B) ? (A) : (B))
231 #define abs(X) ((X) < 0 ? -(X) : (X))
234 /* Non-zero if face attribute ATTR is unspecified. */
236 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
238 /* Value is the number of elements of VECTOR. */
240 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
242 /* Make a copy of string S on the stack using alloca. Value is a pointer
245 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
247 /* Make a copy of the contents of Lisp string S on the stack using
248 alloca. Value is a pointer to the copy. */
250 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
252 /* Size of hash table of realized faces in face caches (should be a
255 #define FACE_CACHE_BUCKETS_SIZE 1001
257 /* A definition of XColor for non-X frames. */
258 #ifndef HAVE_X_WINDOWS
261 unsigned short red
, green
, blue
;
267 /* Keyword symbols used for face attribute names. */
269 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
270 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
271 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
272 Lisp_Object QCreverse_video
;
273 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
275 /* Symbols used for attribute values. */
277 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
278 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
279 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
280 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
281 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
282 Lisp_Object Qultra_expanded
;
283 Lisp_Object Qreleased_button
, Qpressed_button
;
284 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
285 Lisp_Object Qunspecified
;
287 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
289 /* The symbol `x-charset-registry'. This property of charsets defines
290 the X registry and encoding that fonts should have that are used to
291 display characters of that charset. */
293 Lisp_Object Qx_charset_registry
;
295 /* The name of the function to call when the background of the frame
296 has changed, frame_update_face_colors. */
298 Lisp_Object Qframe_update_face_colors
;
300 /* Names of basic faces. */
302 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
303 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
304 extern Lisp_Object Qmode_line
;
306 /* The symbol `face-alias'. A symbols having that property is an
307 alias for another face. Value of the property is the name of
310 Lisp_Object Qface_alias
;
312 /* Names of frame parameters related to faces. */
314 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
315 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
317 /* Default stipple pattern used on monochrome displays. This stipple
318 pattern is used on monochrome displays instead of shades of gray
319 for a face background color. See `set-face-stipple' for possible
320 values for this variable. */
322 Lisp_Object Vface_default_stipple
;
324 /* Default registry and encoding to use for charsets whose charset
325 symbols don't specify one. */
327 Lisp_Object Vface_default_registry
;
329 /* Alist of alternative font families. Each element is of the form
330 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
331 try FAMILY1, then FAMILY2, ... */
333 Lisp_Object Vface_alternative_font_family_alist
;
335 /* Allowed scalable fonts. A value of nil means don't allow any
336 scalable fonts. A value of t means allow the use of any scalable
337 font. Otherwise, value must be a list of regular expressions. A
338 font may be scaled if its name matches a regular expression in the
342 Lisp_Object Vscalable_fonts_allowed
;
345 /* Maximum number of fonts to consider in font_list. If not an
346 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
348 Lisp_Object Vfont_list_limit
;
349 #define DEFAULT_FONT_LIST_LIMIT 100
351 /* The symbols `foreground-color' and `background-color' which can be
352 used as part of a `face' property. This is for compatibility with
355 Lisp_Object Qforeground_color
, Qbackground_color
;
357 /* The symbols `face' and `mouse-face' used as text properties. */
360 extern Lisp_Object Qmouse_face
;
362 /* Error symbol for wrong_type_argument in load_pixmap. */
364 Lisp_Object Qbitmap_spec_p
;
366 /* Alist of global face definitions. Each element is of the form
367 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
368 is a Lisp vector of face attributes. These faces are used
369 to initialize faces for new frames. */
371 Lisp_Object Vface_new_frame_defaults
;
373 /* The next ID to assign to Lisp faces. */
375 static int next_lface_id
;
377 /* A vector mapping Lisp face Id's to face names. */
379 static Lisp_Object
*lface_id_to_name
;
380 static int lface_id_to_name_size
;
382 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
383 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
385 /* Counter for calls to clear_face_cache. If this counter reaches
386 CLEAR_FONT_TABLE_COUNT, and a frame has more than
387 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
389 static int clear_font_table_count
;
390 #define CLEAR_FONT_TABLE_COUNT 100
391 #define CLEAR_FONT_TABLE_NFONTS 10
393 /* Non-zero means face attributes have been changed since the last
394 redisplay. Used in redisplay_internal. */
396 int face_change_count
;
398 /* The total number of colors currently allocated. */
401 static int ncolors_allocated
;
402 static int npixmaps_allocated
;
408 /* Function prototypes. */
413 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
414 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
415 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
416 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
418 static int first_font_matching
P_ ((struct frame
*f
, char *,
419 struct font_name
*));
420 static int x_face_list_fonts
P_ ((struct frame
*, char *,
421 struct font_name
*, int, int, int));
422 static int font_scalable_p
P_ ((struct font_name
*));
423 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
424 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
425 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
426 static char *xstrdup
P_ ((char *));
427 static unsigned char *xstrlwr
P_ ((unsigned char *));
428 static void signal_error
P_ ((char *, Lisp_Object
));
429 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
430 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
431 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
432 static void free_face_colors
P_ ((struct frame
*, struct face
*));
433 static int face_color_gray_p
P_ ((struct frame
*, char *));
434 static char *build_font_name
P_ ((struct font_name
*));
435 static void free_font_names
P_ ((struct font_name
*, int));
436 static int sorted_font_list
P_ ((struct frame
*, char *,
437 int (*cmpfn
) P_ ((const void *, const void *)),
438 struct font_name
**));
439 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
440 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
441 struct font_name
**));
442 static int cmp_font_names
P_ ((const void *, const void *));
443 static struct face
*realize_face
P_ ((struct face_cache
*,
444 Lisp_Object
*, int));
445 static struct face
*realize_x_face
P_ ((struct face_cache
*,
446 Lisp_Object
*, int));
447 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
448 Lisp_Object
*, int));
449 static int realize_basic_faces
P_ ((struct frame
*));
450 static int realize_default_face
P_ ((struct frame
*));
451 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
452 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
453 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
454 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
455 static unsigned lface_hash
P_ ((Lisp_Object
*));
456 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
457 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
458 static void free_realized_face
P_ ((struct frame
*, struct face
*));
459 static void clear_face_gcs
P_ ((struct face_cache
*));
460 static void free_face_cache
P_ ((struct face_cache
*));
461 static int face_numeric_weight
P_ ((Lisp_Object
));
462 static int face_numeric_slant
P_ ((Lisp_Object
));
463 static int face_numeric_swidth
P_ ((Lisp_Object
));
464 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
465 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
467 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
469 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
470 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
472 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
474 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
475 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
476 static void free_realized_faces
P_ ((struct face_cache
*));
477 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
478 struct font_name
*, int));
479 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
480 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
481 static int xlfd_numeric_slant
P_ ((struct font_name
*));
482 static int xlfd_numeric_weight
P_ ((struct font_name
*));
483 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
484 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
485 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
486 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
487 static int xlfd_fixed_p
P_ ((struct font_name
*));
488 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
490 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
491 struct font_name
*, int, int));
492 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
493 struct font_name
*, int));
495 #ifdef HAVE_X_WINDOWS
497 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
498 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
499 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
500 int (*cmpfn
) P_ ((const void *, const void *))));
501 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
502 static void x_free_gc
P_ ((struct frame
*, GC
));
503 static void clear_font_table
P_ ((struct frame
*));
505 #endif /* HAVE_X_WINDOWS */
508 /***********************************************************************
510 ***********************************************************************/
512 #ifdef HAVE_X_WINDOWS
514 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
515 color values. Interrupt input must be blocked when this function
519 x_free_colors (f
, pixels
, npixels
)
521 unsigned long *pixels
;
524 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
526 /* If display has an immutable color map, freeing colors is not
527 necessary and some servers don't allow it. So don't do it. */
528 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
530 Display
*dpy
= FRAME_X_DISPLAY (f
);
531 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
532 int screen_no
= XScreenNumberOfScreen (FRAME_X_SCREEN (f
));
533 unsigned long black
= BlackPixel (dpy
, screen_no
);
534 unsigned long white
= WhitePixel (dpy
, screen_no
);
538 px
= (unsigned long *) alloca (npixels
* sizeof *px
);
539 for (i
= j
= 0; i
< npixels
; ++i
)
540 if (pixels
[i
] != black
&& pixels
[i
] != white
)
544 XFreeColors (dpy
, cmap
, px
, j
, 0);
548 /* Create and return a GC for use on frame F. GC values and mask
549 are given by XGCV and MASK. */
552 x_create_gc (f
, mask
, xgcv
)
559 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
566 /* Free GC which was used on frame F. */
574 xassert (--ngcs
>= 0);
575 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
579 #endif /* HAVE_X_WINDOWS */
582 /* Like strdup, but uses xmalloc. */
588 int len
= strlen (s
) + 1;
589 char *p
= (char *) xmalloc (len
);
595 /* Like stricmp. Used to compare parts of font names which are in
600 unsigned char *s1
, *s2
;
604 unsigned char c1
= tolower (*s1
);
605 unsigned char c2
= tolower (*s2
);
607 return c1
< c2
? -1 : 1;
612 return *s2
== 0 ? 0 : -1;
617 /* Like strlwr, which might not always be available. */
619 static unsigned char *
623 unsigned char *p
= s
;
632 /* Signal `error' with message S, and additional argument ARG. */
635 signal_error (s
, arg
)
639 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
643 /* If FRAME is nil, return a pointer to the selected frame.
644 Otherwise, check that FRAME is a live frame, and return a pointer
645 to it. NPARAM is the parameter number of FRAME, for
646 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
647 Lisp function definitions. */
649 static INLINE
struct frame
*
650 frame_or_selected_frame (frame
, nparam
)
655 frame
= selected_frame
;
657 CHECK_LIVE_FRAME (frame
, nparam
);
658 return XFRAME (frame
);
662 /***********************************************************************
664 ***********************************************************************/
666 /* Initialize face cache and basic faces for frame F. */
672 /* Make a face cache, if F doesn't have one. */
673 if (FRAME_FACE_CACHE (f
) == NULL
)
674 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
676 #ifdef HAVE_X_WINDOWS
677 /* Make the image cache. */
680 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
681 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
682 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
684 #endif /* HAVE_X_WINDOWS */
686 /* Realize basic faces. Must have enough information in frame
687 parameters to realize basic faces at this point. */
688 #ifdef HAVE_X_WINDOWS
689 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
691 if (!realize_basic_faces (f
))
696 /* Free face cache of frame F. Called from Fdelete_frame. */
702 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
706 free_face_cache (face_cache
);
707 FRAME_FACE_CACHE (f
) = NULL
;
710 #ifdef HAVE_X_WINDOWS
713 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
716 --image_cache
->refcount
;
717 if (image_cache
->refcount
== 0)
718 free_image_cache (f
);
721 #endif /* HAVE_X_WINDOWS */
725 /* Clear face caches, and recompute basic faces for frame F. Call
726 this after changing frame parameters on which those faces depend,
727 or when realized faces have been freed due to changing attributes
731 recompute_basic_faces (f
)
734 if (FRAME_FACE_CACHE (f
))
736 clear_face_cache (0);
737 if (!realize_basic_faces (f
))
743 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
744 try to free unused fonts, too. */
747 clear_face_cache (clear_fonts_p
)
750 #ifdef HAVE_X_WINDOWS
751 Lisp_Object tail
, frame
;
755 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
757 /* From time to time see if we can unload some fonts. This also
758 frees all realized faces on all frames. Fonts needed by
759 faces will be loaded again when faces are realized again. */
760 clear_font_table_count
= 0;
762 FOR_EACH_FRAME (tail
, frame
)
766 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
768 free_all_realized_faces (frame
);
769 clear_font_table (f
);
775 /* Clear GCs of realized faces. */
776 FOR_EACH_FRAME (tail
, frame
)
781 clear_face_gcs (FRAME_FACE_CACHE (f
));
782 clear_image_cache (f
, 0);
786 #endif /* HAVE_X_WINDOWS */
790 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
791 "Clear face caches on all frames.\n\
792 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
794 Lisp_Object thorougly
;
796 clear_face_cache (!NILP (thorougly
));
802 #ifdef HAVE_X_WINDOWS
805 /* Remove those fonts from the font table of frame F that are not used
806 by fontsets. Called from clear_face_cache from time to time. */
812 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
814 Lisp_Object rest
, frame
;
817 xassert (FRAME_X_P (f
));
819 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
820 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
822 /* For all frames with the same x_display_info as F, record
823 in `used' those fonts that are in use by fontsets. */
824 FOR_EACH_FRAME (rest
, frame
)
825 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
827 struct frame
*f
= XFRAME (frame
);
828 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
830 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
832 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
835 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
837 int idx
= info
->font_indexes
[j
];
844 /* Free those fonts that are not used by fontsets. */
845 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
846 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
848 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
850 /* Free names. In xfns.c there is a comment that full_name
851 should never be freed because it is always shared with
852 something else. I don't think this is true anymore---see
853 x_load_font. It's either equal to font_info->name or
854 allocated via xmalloc, and there seems to be no place in
855 the source files where full_name is transferred to another
857 if (font_info
->full_name
!= font_info
->name
)
858 xfree (font_info
->full_name
);
859 xfree (font_info
->name
);
863 XFreeFont (dpyinfo
->display
, font_info
->font
);
866 /* Mark font table slot free. */
867 font_info
->font
= NULL
;
868 font_info
->name
= font_info
->full_name
= NULL
;
873 #endif /* HAVE_X_WINDOWS */
877 /***********************************************************************
879 ***********************************************************************/
881 #ifdef HAVE_X_WINDOWS
883 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
884 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
885 A bitmap specification is either a string, a file name, or a list\n\
886 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
887 HEIGHT is its height, and DATA is a string containing the bits of\n\
888 the pixmap. Bits are stored row by row, each row occupies\n\
889 (WIDTH + 7)/8 bytes.")
895 if (STRINGP (object
))
896 /* If OBJECT is a string, it's a file name. */
898 else if (CONSP (object
))
900 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
901 HEIGHT must be integers > 0, and DATA must be string large
902 enough to hold a bitmap of the specified size. */
903 Lisp_Object width
, height
, data
;
905 height
= width
= data
= Qnil
;
909 width
= XCAR (object
);
910 object
= XCDR (object
);
913 height
= XCAR (object
);
914 object
= XCDR (object
);
916 data
= XCAR (object
);
920 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
922 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
924 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
929 return pixmap_p
? Qt
: Qnil
;
933 /* Load a bitmap according to NAME (which is either a file name or a
934 pixmap spec) for use on frame F. Value is the bitmap_id (see
935 xfns.c). If NAME is nil, return with a bitmap id of zero. If
936 bitmap cannot be loaded, display a message saying so, and return
937 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
938 if these pointers are not null. */
941 load_pixmap (f
, name
, w_ptr
, h_ptr
)
944 unsigned int *w_ptr
, *h_ptr
;
952 tem
= Fbitmap_spec_p (name
);
954 wrong_type_argument (Qbitmap_spec_p
, name
);
959 /* Decode a bitmap spec into a bitmap. */
964 w
= XINT (Fcar (name
));
965 h
= XINT (Fcar (Fcdr (name
)));
966 bits
= Fcar (Fcdr (Fcdr (name
)));
968 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
973 /* It must be a string -- a file name. */
974 bitmap_id
= x_create_bitmap_from_file (f
, name
);
980 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
991 ++npixmaps_allocated
;
994 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
997 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1003 #endif /* HAVE_X_WINDOWS */
1007 /***********************************************************************
1009 ***********************************************************************/
1011 #ifdef HAVE_X_WINDOWS
1013 /* Update the line_height of frame F. Return non-zero if line height
1017 frame_update_line_height (f
)
1020 int fontset
, line_height
, changed_p
;
1022 fontset
= f
->output_data
.x
->fontset
;
1024 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
1026 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
1028 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
1029 f
->output_data
.x
->line_height
= line_height
;
1033 #endif /* HAVE_X_WINDOWS */
1036 /***********************************************************************
1038 ***********************************************************************/
1040 #ifdef HAVE_X_WINDOWS
1042 /* Load font or fontset of face FACE which is used on frame F.
1043 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1044 fontset. FONT_NAME is the name of the font to load, if no fontset
1045 is used. It is null if no suitable font name could be determined
1049 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1055 struct font_info
*font_info
= NULL
;
1057 face
->font_info_id
= -1;
1058 face
->fontset
= fontset
;
1063 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1066 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1075 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1076 face
->font
= font_info
->font
;
1077 face
->font_name
= font_info
->full_name
;
1079 /* Make the registry part of the font name readily accessible.
1080 The registry is used to find suitable faces for unibyte text. */
1081 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1083 while (i
< 2 && --s
>= font_info
->full_name
)
1087 if (!STRINGP (face
->registry
)
1088 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1090 if (STRINGP (Vface_default_registry
)
1091 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1092 face
->registry
= Vface_default_registry
;
1094 face
->registry
= build_string (s
+ 1);
1097 else if (fontset
>= 0)
1098 add_to_log ("Unable to load ASCII font of fontset %d",
1099 make_number (fontset
), Qnil
);
1101 add_to_log ("Unable to load font %s",
1102 build_string (font_name
), Qnil
);
1105 #endif /* HAVE_X_WINDOWS */
1109 /***********************************************************************
1111 ***********************************************************************/
1113 /* A version of defined_color for non-X frames. */
1115 tty_defined_color (f
, color_name
, color_def
, alloc
)
1121 Lisp_Object color_desc
;
1122 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
,
1123 red
= 0, green
= 0, blue
= 0;
1126 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1130 XSETFRAME (frame
, f
);
1132 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1133 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1135 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1136 if (CONSP (XCDR (XCDR (color_desc
))))
1138 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1139 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1140 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1144 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1145 /* We were called early during startup, and the colors are not
1146 yet set up in tty-defined-color-alist. Don't return a failure
1147 indication, since this produces the annoying "Unable to
1148 load color" messages in the *Messages* buffer. */
1151 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1153 if (strcmp (color_name
, "unspecified-fg") == 0)
1154 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1155 else if (strcmp (color_name
, "unspecified-bg") == 0)
1156 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1159 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1162 color_def
->pixel
= color_idx
;
1163 color_def
->red
= red
;
1164 color_def
->green
= green
;
1165 color_def
->blue
= blue
;
1170 /* Decide if color named COLOR is valid for the display associated
1171 with the frame F; if so, return the rgb values in COLOR_DEF. If
1172 ALLOC is nonzero, allocate a new colormap cell.
1174 This does the right thing for any type of frame. */
1176 defined_color (f
, color_name
, color_def
, alloc
)
1182 if (!FRAME_WINDOW_P (f
))
1183 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1184 #ifdef HAVE_X_WINDOWS
1185 else if (FRAME_X_P (f
))
1186 return x_defined_color (f
, color_name
, color_def
, alloc
);
1189 else if (FRAME_W32_P (f
))
1190 /* FIXME: w32_defined_color doesn't exist! w32fns.c defines
1191 defined_color which needs to be renamed, and the declaration
1192 of color_def therein should be changed. */
1193 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1196 else if (FRAME_MAC_P (f
))
1197 /* FIXME: mac_defined_color doesn't exist! */
1198 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1204 /* Given the index of the tty color, return its name, a Lisp string. */
1207 tty_color_name (f
, idx
)
1213 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1216 Lisp_Object coldesc
;
1218 XSETFRAME (frame
, f
);
1219 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1221 if (!NILP (coldesc
))
1222 return XCAR (coldesc
);
1225 /* We can have an MSDOG frame under -nw for a short window of
1226 opportunity before internal_terminal_init is called. DTRT. */
1227 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1228 return msdos_stdcolor_name (idx
);
1232 /* FIXME: When/if w32 supports colors in non-window mode, there should
1233 be a call here to a w32-specific function that returns the color
1234 by index using the default color mapping on a Windows console. */
1237 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1238 return build_string (unspecified_fg
);
1239 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1240 return build_string (unspecified_bg
);
1241 return Qunspecified
;
1244 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1245 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1248 face_color_gray_p (f
, color_name
)
1255 if (defined_color (f
, color_name
, &color
, 0))
1256 gray_p
= ((abs (color
.red
- color
.green
)
1257 < max (color
.red
, color
.green
) / 20)
1258 && (abs (color
.green
- color
.blue
)
1259 < max (color
.green
, color
.blue
) / 20)
1260 && (abs (color
.blue
- color
.red
)
1261 < max (color
.blue
, color
.red
) / 20));
1269 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1270 BACKGROUND_P non-zero means the color will be used as background
1274 face_color_supported_p (f
, color_name
, background_p
)
1282 XSETFRAME (frame
, f
);
1283 return (FRAME_WINDOW_P (f
)
1284 ? (!NILP (Fxw_display_color_p (frame
))
1285 || xstricmp (color_name
, "black") == 0
1286 || xstricmp (color_name
, "white") == 0
1288 && face_color_gray_p (f
, color_name
))
1289 || (!NILP (Fx_display_grayscale_p (frame
))
1290 && face_color_gray_p (f
, color_name
)))
1291 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1295 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1296 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1297 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1298 If FRAME is nil or omitted, use the selected frame.")
1300 Lisp_Object color
, frame
;
1304 CHECK_FRAME (frame
, 0);
1305 CHECK_STRING (color
, 0);
1307 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1311 DEFUN ("color-supported-p", Fcolor_supported_p
,
1312 Scolor_supported_p
, 2, 3, 0,
1313 "Return non-nil if COLOR can be displayed on FRAME.\n\
1314 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1315 If FRAME is nil or omitted, use the selected frame.\n\
1316 COLOR must be a valid color name.")
1317 (color
, frame
, background_p
)
1318 Lisp_Object frame
, color
, background_p
;
1322 CHECK_FRAME (frame
, 0);
1323 CHECK_STRING (color
, 0);
1325 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1330 /* Load color with name NAME for use by face FACE on frame F.
1331 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1332 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1333 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1334 pixel color. If color cannot be loaded, display a message, and
1335 return the foreground, background or underline color of F, but
1336 record that fact in flags of the face so that we don't try to free
1340 load_color (f
, face
, name
, target_index
)
1344 enum lface_attribute_index target_index
;
1348 xassert (STRINGP (name
));
1349 xassert (target_index
== LFACE_FOREGROUND_INDEX
1350 || target_index
== LFACE_BACKGROUND_INDEX
1351 || target_index
== LFACE_UNDERLINE_INDEX
1352 || target_index
== LFACE_OVERLINE_INDEX
1353 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1354 || target_index
== LFACE_BOX_INDEX
);
1356 /* if the color map is full, defined_color will return a best match
1357 to the values in an existing cell. */
1358 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1360 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1362 switch (target_index
)
1364 case LFACE_FOREGROUND_INDEX
:
1365 face
->foreground_defaulted_p
= 1;
1366 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1369 case LFACE_BACKGROUND_INDEX
:
1370 face
->background_defaulted_p
= 1;
1371 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1374 case LFACE_UNDERLINE_INDEX
:
1375 face
->underline_defaulted_p
= 1;
1376 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1379 case LFACE_OVERLINE_INDEX
:
1380 face
->overline_color_defaulted_p
= 1;
1381 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1384 case LFACE_STRIKE_THROUGH_INDEX
:
1385 face
->strike_through_color_defaulted_p
= 1;
1386 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1389 case LFACE_BOX_INDEX
:
1390 face
->box_color_defaulted_p
= 1;
1391 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1400 ++ncolors_allocated
;
1406 #ifdef HAVE_X_WINDOWS
1408 /* Load colors for face FACE which is used on frame F. Colors are
1409 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1410 of ATTRS. If the background color specified is not supported on F,
1411 try to emulate gray colors with a stipple from Vface_default_stipple. */
1414 load_face_colors (f
, face
, attrs
)
1421 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1422 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1424 /* Swap colors if face is inverse-video. */
1425 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1433 /* Check for support for foreground, not for background because
1434 face_color_supported_p is smart enough to know that grays are
1435 "supported" as background because we are supposed to use stipple
1437 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1438 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1440 x_destroy_bitmap (f
, face
->stipple
);
1441 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1442 &face
->pixmap_w
, &face
->pixmap_h
);
1445 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1446 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1450 /* Free color PIXEL on frame F. */
1453 unload_color (f
, pixel
)
1455 unsigned long pixel
;
1458 x_free_colors (f
, &pixel
, 1);
1463 /* Free colors allocated for FACE. */
1466 free_face_colors (f
, face
)
1470 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1472 /* If display has an immutable color map, freeing colors is not
1473 necessary and some servers don't allow it. So don't do it. */
1474 if (class != StaticColor
1475 && class != StaticGray
1476 && class != TrueColor
)
1480 if (!face
->foreground_defaulted_p
)
1482 x_free_colors (f
, &face
->foreground
, 1);
1483 IF_DEBUG (--ncolors_allocated
);
1486 if (!face
->background_defaulted_p
)
1488 x_free_colors (f
, &face
->background
, 1);
1489 IF_DEBUG (--ncolors_allocated
);
1492 if (face
->underline_p
1493 && !face
->underline_defaulted_p
)
1495 x_free_colors (f
, &face
->underline_color
, 1);
1496 IF_DEBUG (--ncolors_allocated
);
1499 if (face
->overline_p
1500 && !face
->overline_color_defaulted_p
)
1502 x_free_colors (f
, &face
->overline_color
, 1);
1503 IF_DEBUG (--ncolors_allocated
);
1506 if (face
->strike_through_p
1507 && !face
->strike_through_color_defaulted_p
)
1509 x_free_colors (f
, &face
->strike_through_color
, 1);
1510 IF_DEBUG (--ncolors_allocated
);
1513 if (face
->box
!= FACE_NO_BOX
1514 && !face
->box_color_defaulted_p
)
1516 x_free_colors (f
, &face
->box_color
, 1);
1517 IF_DEBUG (--ncolors_allocated
);
1523 #endif /* HAVE_X_WINDOWS */
1527 /***********************************************************************
1529 ***********************************************************************/
1531 /* An enumerator for each field of an XLFD font name. */
1552 /* An enumerator for each possible slant value of a font. Taken from
1553 the XLFD specification. */
1561 XLFD_SLANT_REVERSE_ITALIC
,
1562 XLFD_SLANT_REVERSE_OBLIQUE
,
1566 /* Relative font weight according to XLFD documentation. */
1570 XLFD_WEIGHT_UNKNOWN
,
1571 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1572 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1573 XLFD_WEIGHT_LIGHT
, /* 30 */
1574 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1575 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1576 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1577 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1578 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1579 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1582 /* Relative proportionate width. */
1586 XLFD_SWIDTH_UNKNOWN
,
1587 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1588 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1589 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1590 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1591 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1592 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1593 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1594 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1595 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1598 /* Structure used for tables mapping XLFD weight, slant, and width
1599 names to numeric and symbolic values. */
1605 Lisp_Object
*symbol
;
1608 /* Table of XLFD slant names and their numeric and symbolic
1609 representations. This table must be sorted by slant names in
1612 static struct table_entry slant_table
[] =
1614 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1615 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1616 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1617 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1618 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1619 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1622 /* Table of XLFD weight names. This table must be sorted by weight
1623 names in ascending order. */
1625 static struct table_entry weight_table
[] =
1627 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1628 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1629 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1630 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1631 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1632 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1633 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1634 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1635 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1636 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1637 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1638 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1639 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1640 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1641 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1644 /* Table of XLFD width names. This table must be sorted by width
1645 names in ascending order. */
1647 static struct table_entry swidth_table
[] =
1649 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1650 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1651 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1652 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1653 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1654 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1655 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1656 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1657 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1658 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1659 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1660 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1661 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1662 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1663 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1666 /* Structure used to hold the result of splitting font names in XLFD
1667 format into their fields. */
1671 /* The original name which is modified destructively by
1672 split_font_name. The pointer is kept here to be able to free it
1673 if it was allocated from the heap. */
1676 /* Font name fields. Each vector element points into `name' above.
1677 Fields are NUL-terminated. */
1678 char *fields
[XLFD_LAST
];
1680 /* Numeric values for those fields that interest us. See
1681 split_font_name for which these are. */
1682 int numeric
[XLFD_LAST
];
1685 /* The frame in effect when sorting font names. Set temporarily in
1686 sort_fonts so that it is available in font comparison functions. */
1688 static struct frame
*font_frame
;
1690 /* Order by which font selection chooses fonts. The default values
1691 mean `first, find a best match for the font width, then for the
1692 font height, then for weight, then for slant.' This variable can be
1693 set via set-face-font-sort-order. */
1695 static int font_sort_order
[4];
1698 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1699 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1700 is a pointer to the matching table entry or null if no table entry
1703 static struct table_entry
*
1704 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1705 struct table_entry
*table
;
1707 struct font_name
*font
;
1710 /* Function split_font_name converts fields to lower-case, so there
1711 is no need to use xstrlwr or xstricmp here. */
1712 char *s
= font
->fields
[field_index
];
1713 int low
, mid
, high
, cmp
;
1720 mid
= (low
+ high
) / 2;
1721 cmp
= strcmp (table
[mid
].name
, s
);
1735 /* Return a numeric representation for font name field
1736 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1737 has DIM entries. Value is the numeric value found or DFLT if no
1738 table entry matches. This function is used to translate weight,
1739 slant, and swidth names of XLFD font names to numeric values. */
1742 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1743 struct table_entry
*table
;
1745 struct font_name
*font
;
1749 struct table_entry
*p
;
1750 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1751 return p
? p
->numeric
: dflt
;
1755 /* Return a symbolic representation for font name field
1756 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1757 has DIM entries. Value is the symbolic value found or DFLT if no
1758 table entry matches. This function is used to translate weight,
1759 slant, and swidth names of XLFD font names to symbols. */
1761 static INLINE Lisp_Object
1762 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1763 struct table_entry
*table
;
1765 struct font_name
*font
;
1769 struct table_entry
*p
;
1770 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1771 return p
? *p
->symbol
: dflt
;
1775 /* Return a numeric value for the slant of the font given by FONT. */
1778 xlfd_numeric_slant (font
)
1779 struct font_name
*font
;
1781 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1782 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1786 /* Return a symbol representing the weight of the font given by FONT. */
1788 static INLINE Lisp_Object
1789 xlfd_symbolic_slant (font
)
1790 struct font_name
*font
;
1792 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1793 font
, XLFD_SLANT
, Qnormal
);
1797 /* Return a numeric value for the weight of the font given by FONT. */
1800 xlfd_numeric_weight (font
)
1801 struct font_name
*font
;
1803 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1804 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1808 /* Return a symbol representing the slant of the font given by FONT. */
1810 static INLINE Lisp_Object
1811 xlfd_symbolic_weight (font
)
1812 struct font_name
*font
;
1814 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1815 font
, XLFD_WEIGHT
, Qnormal
);
1819 /* Return a numeric value for the swidth of the font whose XLFD font
1820 name fields are found in FONT. */
1823 xlfd_numeric_swidth (font
)
1824 struct font_name
*font
;
1826 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1827 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1831 /* Return a symbolic value for the swidth of FONT. */
1833 static INLINE Lisp_Object
1834 xlfd_symbolic_swidth (font
)
1835 struct font_name
*font
;
1837 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1838 font
, XLFD_SWIDTH
, Qnormal
);
1842 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1843 entries. Value is a pointer to the matching table entry or null if
1844 no element of TABLE contains SYMBOL. */
1846 static struct table_entry
*
1847 face_value (table
, dim
, symbol
)
1848 struct table_entry
*table
;
1854 xassert (SYMBOLP (symbol
));
1856 for (i
= 0; i
< dim
; ++i
)
1857 if (EQ (*table
[i
].symbol
, symbol
))
1860 return i
< dim
? table
+ i
: NULL
;
1864 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1865 entries. Value is -1 if SYMBOL is not found in TABLE. */
1868 face_numeric_value (table
, dim
, symbol
)
1869 struct table_entry
*table
;
1873 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1874 return p
? p
->numeric
: -1;
1878 /* Return a numeric value representing the weight specified by Lisp
1879 symbol WEIGHT. Value is one of the enumerators of enum
1883 face_numeric_weight (weight
)
1886 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1890 /* Return a numeric value representing the slant specified by Lisp
1891 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1894 face_numeric_slant (slant
)
1897 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1901 /* Return a numeric value representing the swidth specified by Lisp
1902 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1905 face_numeric_swidth (width
)
1908 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1912 #ifdef HAVE_X_WINDOWS
1914 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1918 struct font_name
*font
;
1920 /* Function split_font_name converts fields to lower-case, so there
1921 is no need to use tolower here. */
1922 return *font
->fields
[XLFD_SPACING
] != 'p';
1926 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1928 The actual height of the font when displayed on F depends on the
1929 resolution of both the font and frame. For example, a 10pt font
1930 designed for a 100dpi display will display larger than 10pt on a
1931 75dpi display. (It's not unusual to use fonts not designed for the
1932 display one is using. For example, some intlfonts are available in
1933 72dpi versions, only.)
1935 Value is the real point size of FONT on frame F, or 0 if it cannot
1939 xlfd_point_size (f
, font
)
1941 struct font_name
*font
;
1943 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1944 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1945 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1948 if (font_resy
== 0 || font_pt
== 0)
1951 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1957 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1958 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1959 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1960 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1961 zero if the font name doesn't have the format we expect. The
1962 expected format is a font name that starts with a `-' and has
1963 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1964 forms of font names where certain field contents are enclosed in
1965 square brackets. We don't support that, for now. */
1968 split_font_name (f
, font
, numeric_p
)
1970 struct font_name
*font
;
1976 if (*font
->name
== '-')
1978 char *p
= xstrlwr (font
->name
) + 1;
1980 while (i
< XLFD_LAST
)
1982 font
->fields
[i
] = p
;
1985 while (*p
&& *p
!= '-')
1995 success_p
= i
== XLFD_LAST
;
1997 /* If requested, and font name was in the expected format,
1998 compute numeric values for some fields. */
1999 if (numeric_p
&& success_p
)
2001 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2002 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2003 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2004 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2005 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2012 /* Build an XLFD font name from font name fields in FONT. Value is a
2013 pointer to the font name, which is allocated via xmalloc. */
2016 build_font_name (font
)
2017 struct font_name
*font
;
2021 char *font_name
= (char *) xmalloc (size
);
2022 int total_length
= 0;
2024 for (i
= 0; i
< XLFD_LAST
; ++i
)
2026 /* Add 1 because of the leading `-'. */
2027 int len
= strlen (font
->fields
[i
]) + 1;
2029 /* Reallocate font_name if necessary. Add 1 for the final
2031 if (total_length
+ len
+ 1 >= size
)
2033 int new_size
= max (2 * size
, size
+ len
+ 1);
2034 int sz
= new_size
* sizeof *font_name
;
2035 font_name
= (char *) xrealloc (font_name
, sz
);
2039 font_name
[total_length
] = '-';
2040 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2041 total_length
+= len
;
2044 font_name
[total_length
] = 0;
2049 /* Free an array FONTS of N font_name structures. This frees FONTS
2050 itself and all `name' fields in its elements. */
2053 free_font_names (fonts
, n
)
2054 struct font_name
*fonts
;
2058 xfree (fonts
[--n
].name
);
2063 /* Sort vector FONTS of font_name structures which contains NFONTS
2064 elements using qsort and comparison function CMPFN. F is the frame
2065 on which the fonts will be used. The global variable font_frame
2066 is temporarily set to F to make it available in CMPFN. */
2069 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2071 struct font_name
*fonts
;
2073 int (*cmpfn
) P_ ((const void *, const void *));
2076 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2081 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2082 display in x_display_list. FONTS is a pointer to a vector of
2083 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2084 alternative patterns from Valternate_fontname_alist if no fonts are
2085 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2088 For all fonts found, set FONTS[i].name to the name of the font,
2089 allocated via xmalloc, and split font names into fields. Ignore
2090 fonts that we can't parse. Value is the number of fonts found.
2092 This is similar to x_list_fonts. The differences are:
2094 1. It avoids consing.
2095 2. It never calls XLoadQueryFont. */
2098 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2102 struct font_name
*fonts
;
2103 int nfonts
, try_alternatives_p
;
2104 int scalable_fonts_p
;
2106 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2110 /* Get the list of fonts matching PATTERN from the X server. */
2112 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2117 /* Make a copy of the font names we got from X, and
2118 split them into fields. */
2119 for (i
= j
= 0; i
< n
; ++i
)
2121 /* Make a copy of the font name. */
2122 fonts
[j
].name
= xstrdup (names
[i
]);
2124 /* Ignore fonts having a name that we can't parse. */
2125 if (!split_font_name (f
, fonts
+ j
, 1))
2126 xfree (fonts
[j
].name
);
2127 else if (font_scalable_p (fonts
+ j
))
2130 if (!scalable_fonts_p
2131 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2132 xfree (fonts
[j
].name
);
2135 #else /* !SCALABLE_FONTS */
2136 /* Always ignore scalable fonts. */
2137 xfree (fonts
[j
].name
);
2138 #endif /* !SCALABLE_FONTS */
2146 /* Free font names. */
2148 XFreeFontNames (names
);
2153 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2154 if (n
== 0 && try_alternatives_p
)
2156 Lisp_Object list
= Valternate_fontname_alist
;
2158 while (CONSP (list
))
2160 Lisp_Object entry
= XCAR (list
);
2162 && STRINGP (XCAR (entry
))
2163 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2170 Lisp_Object patterns
= XCAR (list
);
2173 while (CONSP (patterns
)
2174 /* If list is screwed up, give up. */
2175 && (name
= XCAR (patterns
),
2177 /* Ignore patterns equal to PATTERN because we tried that
2178 already with no success. */
2179 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2180 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2184 patterns
= XCDR (patterns
);
2192 /* Determine the first font matching PATTERN on frame F. Return in
2193 *FONT the matching font name, split into fields. Value is non-zero
2194 if a match was found. */
2197 first_font_matching (f
, pattern
, font
)
2200 struct font_name
*font
;
2203 struct font_name
*fonts
;
2205 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2206 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2210 bcopy (&fonts
[0], font
, sizeof *font
);
2212 fonts
[0].name
= NULL
;
2213 free_font_names (fonts
, nfonts
);
2220 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2221 using comparison function CMPFN. Value is the number of fonts
2222 found. If value is non-zero, *FONTS is set to a vector of
2223 font_name structures allocated from the heap containing matching
2224 fonts. Each element of *FONTS contains a name member that is also
2225 allocated from the heap. Font names in these structures are split
2226 into fields. Use free_font_names to free such an array. */
2229 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2232 int (*cmpfn
) P_ ((const void *, const void *));
2233 struct font_name
**fonts
;
2237 /* Get the list of fonts matching pattern. 100 should suffice. */
2238 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2239 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2240 nfonts
= XFASTINT (Vfont_list_limit
);
2242 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2244 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2246 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2249 /* Sort the resulting array and return it in *FONTS. If no
2250 fonts were found, make sure to set *FONTS to null. */
2252 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2263 /* Compare two font_name structures *A and *B. Value is analogous to
2264 strcmp. Sort order is given by the global variable
2265 font_sort_order. Font names are sorted so that, everything else
2266 being equal, fonts with a resolution closer to that of the frame on
2267 which they are used are listed first. The global variable
2268 font_frame is the frame on which we operate. */
2271 cmp_font_names (a
, b
)
2274 struct font_name
*x
= (struct font_name
*) a
;
2275 struct font_name
*y
= (struct font_name
*) b
;
2278 /* All strings have been converted to lower-case by split_font_name,
2279 so we can use strcmp here. */
2280 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2285 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2287 int j
= font_sort_order
[i
];
2288 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2293 /* Everything else being equal, we prefer fonts with an
2294 y-resolution closer to that of the frame. */
2295 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2296 int x_resy
= x
->numeric
[XLFD_RESY
];
2297 int y_resy
= y
->numeric
[XLFD_RESY
];
2298 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2306 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2307 is non-null list fonts matching that pattern. Otherwise, if
2308 REGISTRY_AND_ENCODING is non-null return only fonts with that
2309 registry and encoding, otherwise return fonts of any registry and
2310 encoding. Set *FONTS to a vector of font_name structures allocated
2311 from the heap containing the fonts found. Value is the number of
2315 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2319 char *registry_and_encoding
;
2320 struct font_name
**fonts
;
2322 if (pattern
== NULL
)
2327 if (registry_and_encoding
== NULL
)
2328 registry_and_encoding
= "*";
2330 pattern
= (char *) alloca (strlen (family
)
2331 + strlen (registry_and_encoding
)
2333 if (index (family
, '-'))
2334 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2336 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2339 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2343 /* Remove elements from LIST whose cars are `equal'. Called from
2344 x-family-fonts and x-font-family-list to remove duplicate font
2348 remove_duplicates (list
)
2351 Lisp_Object tail
= list
;
2353 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2355 Lisp_Object next
= XCDR (tail
);
2356 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2357 XCDR (tail
) = XCDR (next
);
2364 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2365 "Return a list of available fonts of family FAMILY on FRAME.\n\
2366 If FAMILY is omitted or nil, list all families.\n\
2367 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2369 If FRAME is omitted or nil, use the selected frame.\n\
2370 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2371 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2372 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2373 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2374 width, weight and slant of the font. These symbols are the same as for\n\
2375 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2376 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2377 giving the registry and encoding of the font.\n\
2378 The result list is sorted according to the current setting of\n\
2379 the face font sort order.")
2381 Lisp_Object family
, frame
;
2383 struct frame
*f
= check_x_frame (frame
);
2384 struct font_name
*fonts
;
2387 struct gcpro gcpro1
;
2388 char *family_pattern
;
2391 family_pattern
= "*";
2394 CHECK_STRING (family
, 1);
2395 family_pattern
= LSTRDUPA (family
);
2400 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2401 for (i
= nfonts
- 1; i
>= 0; --i
)
2403 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2406 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2408 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2409 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2410 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2411 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2412 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2413 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2414 tem
= build_font_name (fonts
+ i
);
2415 ASET (v
, 6, build_string (tem
));
2416 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2417 fonts
[i
].fields
[XLFD_ENCODING
]);
2418 ASET (v
, 7, build_string (tem
));
2421 result
= Fcons (v
, result
);
2426 remove_duplicates (result
);
2427 free_font_names (fonts
, nfonts
);
2433 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2435 "Return a list of available font families on FRAME.\n\
2436 If FRAME is omitted or nil, use the selected frame.\n\
2437 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2438 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2443 struct frame
*f
= check_x_frame (frame
);
2445 struct font_name
*fonts
;
2447 struct gcpro gcpro1
;
2448 int count
= specpdl_ptr
- specpdl
;
2451 /* Let's consider all fonts. Increase the limit for matching
2452 fonts until we have them all. */
2455 specbind (intern ("font-list-limit"), make_number (limit
));
2456 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2458 if (nfonts
== limit
)
2460 free_font_names (fonts
, nfonts
);
2469 for (i
= nfonts
- 1; i
>= 0; --i
)
2470 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2471 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2474 remove_duplicates (result
);
2475 free_font_names (fonts
, nfonts
);
2477 return unbind_to (count
, result
);
2481 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2482 "Return a list of the names of available fonts matching PATTERN.\n\
2483 If optional arguments FACE and FRAME are specified, return only fonts\n\
2484 the same size as FACE on FRAME.\n\
2485 PATTERN is a string, perhaps with wildcard characters;\n\
2486 the * character matches any substring, and\n\
2487 the ? character matches any single character.\n\
2488 PATTERN is case-insensitive.\n\
2489 FACE is a face name--a symbol.\n\
2491 The return value is a list of strings, suitable as arguments to\n\
2494 Fonts Emacs can't use may or may not be excluded\n\
2495 even if they match PATTERN and FACE.\n\
2496 The optional fourth argument MAXIMUM sets a limit on how many\n\
2497 fonts to match. The first MAXIMUM fonts are reported.\n\
2498 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2499 occupied by a character of a font. In that case, return only fonts\n\
2500 the WIDTH times as wide as FACE on FRAME.")
2501 (pattern
, face
, frame
, maximum
, width
)
2502 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2509 CHECK_STRING (pattern
, 0);
2515 CHECK_NATNUM (maximum
, 0);
2516 maxnames
= XINT (maximum
);
2520 CHECK_NUMBER (width
, 4);
2522 /* We can't simply call check_x_frame because this function may be
2523 called before any frame is created. */
2524 f
= frame_or_selected_frame (frame
, 2);
2527 /* Perhaps we have not yet created any frame. */
2532 /* Determine the width standard for comparison with the fonts we find. */
2538 /* This is of limited utility since it works with character
2539 widths. Keep it for compatibility. --gerd. */
2540 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2541 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2544 size
= face
->font
->max_bounds
.width
;
2546 size
= FRAME_FONT (f
)->max_bounds
.width
;
2549 size
*= XINT (width
);
2553 Lisp_Object args
[2];
2555 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2557 /* We don't have to check fontsets. */
2559 args
[1] = list_fontsets (f
, pattern
, size
);
2560 return Fnconc (2, args
);
2564 #endif /* HAVE_X_WINDOWS */
2568 /***********************************************************************
2570 ***********************************************************************/
2572 /* Access face attributes of face FACE, a Lisp vector. */
2574 #define LFACE_FAMILY(LFACE) \
2575 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2576 #define LFACE_HEIGHT(LFACE) \
2577 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2578 #define LFACE_WEIGHT(LFACE) \
2579 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2580 #define LFACE_SLANT(LFACE) \
2581 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2582 #define LFACE_UNDERLINE(LFACE) \
2583 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2584 #define LFACE_INVERSE(LFACE) \
2585 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2586 #define LFACE_FOREGROUND(LFACE) \
2587 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2588 #define LFACE_BACKGROUND(LFACE) \
2589 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2590 #define LFACE_STIPPLE(LFACE) \
2591 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2592 #define LFACE_SWIDTH(LFACE) \
2593 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2594 #define LFACE_OVERLINE(LFACE) \
2595 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2596 #define LFACE_STRIKE_THROUGH(LFACE) \
2597 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2598 #define LFACE_BOX(LFACE) \
2599 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2601 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2602 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2604 #define LFACEP(LFACE) \
2606 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2607 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2612 /* Check consistency of Lisp face attribute vector ATTRS. */
2615 check_lface_attrs (attrs
)
2618 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2619 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2620 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2621 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2622 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2623 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2624 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2625 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2626 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2627 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2628 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2629 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2630 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2631 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2632 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2633 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2634 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2635 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2636 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2637 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2638 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2639 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2640 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2641 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2642 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2643 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2644 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2645 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2646 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2647 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2648 #ifdef HAVE_WINDOW_SYSTEM
2649 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2650 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2651 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2656 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2664 xassert (LFACEP (lface
));
2665 check_lface_attrs (XVECTOR (lface
)->contents
);
2669 #else /* GLYPH_DEBUG == 0 */
2671 #define check_lface_attrs(attrs) (void) 0
2672 #define check_lface(lface) (void) 0
2674 #endif /* GLYPH_DEBUG == 0 */
2677 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2678 to make it a symvol. If FACE_NAME is an alias for another face,
2679 return that face's name. */
2682 resolve_face_name (face_name
)
2683 Lisp_Object face_name
;
2685 Lisp_Object aliased
;
2687 if (STRINGP (face_name
))
2688 face_name
= intern (XSTRING (face_name
)->data
);
2692 aliased
= Fget (face_name
, Qface_alias
);
2696 face_name
= aliased
;
2703 /* Return the face definition of FACE_NAME on frame F. F null means
2704 return the global definition. FACE_NAME may be a string or a
2705 symbol (apparently Emacs 20.2 allows strings as face names in face
2706 text properties; ediff uses that). If FACE_NAME is an alias for
2707 another face, return that face's definition. If SIGNAL_P is
2708 non-zero, signal an error if FACE_NAME is not a valid face name.
2709 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2712 static INLINE Lisp_Object
2713 lface_from_face_name (f
, face_name
, signal_p
)
2715 Lisp_Object face_name
;
2720 face_name
= resolve_face_name (face_name
);
2723 lface
= assq_no_quit (face_name
, f
->face_alist
);
2725 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2728 lface
= XCDR (lface
);
2730 signal_error ("Invalid face", face_name
);
2732 check_lface (lface
);
2737 /* Get face attributes of face FACE_NAME from frame-local faces on
2738 frame F. Store the resulting attributes in ATTRS which must point
2739 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2740 is non-zero, signal an error if FACE_NAME does not name a face.
2741 Otherwise, value is zero if FACE_NAME is not a face. */
2744 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2746 Lisp_Object face_name
;
2753 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2756 bcopy (XVECTOR (lface
)->contents
, attrs
,
2757 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2767 /* Non-zero if all attributes in face attribute vector ATTRS are
2768 specified, i.e. are non-nil. */
2771 lface_fully_specified_p (attrs
)
2776 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2777 if (UNSPECIFIEDP (attrs
[i
]))
2780 return i
== LFACE_VECTOR_SIZE
;
2784 #ifdef HAVE_X_WINDOWS
2786 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2787 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2788 LFACE. MAY_FAIL_P non-zero means return 0 if FONT_NAME isn't a
2789 valid font name; otherwise this function tries to use a reasonable
2792 Ignore fields of FONT_NAME containing wildcards. Value is zero if
2793 not successful because FONT_NAME was not in a valid format and
2794 MAY_FAIL_P was non-zero. A valid format is one that is suitable
2795 for split_font_name, see the comment there. */
2798 set_lface_from_font_name (f
, lface
, font_name
, force_p
, may_fail_p
)
2802 int force_p
, may_fail_p
;
2804 struct font_name font
;
2807 int free_font_name_p
= 0;
2808 int have_font_p
= 0;
2810 /* If FONT_NAME contains wildcards, use the first matching font. */
2811 if (index (font_name
, '*') || index (font_name
, '?'))
2813 if (first_font_matching (f
, font_name
, &font
))
2814 free_font_name_p
= have_font_p
= 1;
2818 font
.name
= STRDUPA (font_name
);
2819 if (split_font_name (f
, &font
, 1))
2823 /* The font name may be something like `6x13'. Make
2824 sure we use the full name. */
2825 struct font_info
*font_info
;
2828 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2829 CHARSET_ASCII
, font_name
, -1);
2832 font
.name
= STRDUPA (font_info
->full_name
);
2833 split_font_name (f
, &font
, 1);
2840 /* If FONT_NAME is completely bogus try to use something reasonable
2841 if this function must succeed. Otherwise, give up. */
2846 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2848 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2850 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2852 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2854 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2856 || first_font_matching (f
, "fixed", &font
))
2857 free_font_name_p
= 1;
2863 /* Set attributes only if unspecified, otherwise face defaults for
2864 new frames would never take effect. */
2866 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2868 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2869 + strlen (font
.fields
[XLFD_FOUNDRY
])
2871 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2872 font
.fields
[XLFD_FAMILY
]);
2873 LFACE_FAMILY (lface
) = build_string (buffer
);
2876 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2878 pt
= xlfd_point_size (f
, &font
);
2880 LFACE_HEIGHT (lface
) = make_number (pt
);
2883 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2884 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2886 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2887 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2889 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2890 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2892 if (free_font_name_p
)
2898 #endif /* HAVE_X_WINDOWS */
2901 /* Merge two Lisp face attribute vectors FROM and TO and store the
2902 resulting attributes in TO. Every non-nil attribute of FROM
2903 overrides the corresponding attribute of TO. */
2906 merge_face_vectors (from
, to
)
2907 Lisp_Object
*from
, *to
;
2910 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2911 if (!UNSPECIFIEDP (from
[i
]))
2916 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2917 is a face property, determine the resulting face attributes on
2918 frame F, and store them in TO. PROP may be a single face
2919 specification or a list of such specifications. Each face
2920 specification can be
2922 1. A symbol or string naming a Lisp face.
2924 2. A property list of the form (KEYWORD VALUE ...) where each
2925 KEYWORD is a face attribute name, and value is an appropriate value
2928 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2929 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2930 for compatibility with 20.2.
2932 Face specifications earlier in lists take precedence over later
2936 merge_face_vector_with_property (f
, to
, prop
)
2943 Lisp_Object first
= XCAR (prop
);
2945 if (EQ (first
, Qforeground_color
)
2946 || EQ (first
, Qbackground_color
))
2948 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2949 . COLOR). COLOR must be a string. */
2950 Lisp_Object color_name
= XCDR (prop
);
2951 Lisp_Object color
= first
;
2953 if (STRINGP (color_name
))
2955 if (EQ (color
, Qforeground_color
))
2956 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2958 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2961 add_to_log ("Invalid face color", color_name
, Qnil
);
2963 else if (SYMBOLP (first
)
2964 && *XSYMBOL (first
)->name
->data
== ':')
2966 /* Assume this is the property list form. */
2967 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2969 Lisp_Object keyword
= XCAR (prop
);
2970 Lisp_Object value
= XCAR (XCDR (prop
));
2972 if (EQ (keyword
, QCfamily
))
2974 if (STRINGP (value
))
2975 to
[LFACE_FAMILY_INDEX
] = value
;
2977 add_to_log ("Illegal face font family", value
, Qnil
);
2979 else if (EQ (keyword
, QCheight
))
2981 if (INTEGERP (value
))
2982 to
[LFACE_HEIGHT_INDEX
] = value
;
2984 add_to_log ("Illegal face font height", value
, Qnil
);
2986 else if (EQ (keyword
, QCweight
))
2989 && face_numeric_weight (value
) >= 0)
2990 to
[LFACE_WEIGHT_INDEX
] = value
;
2992 add_to_log ("Illegal face weight", value
, Qnil
);
2994 else if (EQ (keyword
, QCslant
))
2997 && face_numeric_slant (value
) >= 0)
2998 to
[LFACE_SLANT_INDEX
] = value
;
3000 add_to_log ("Illegal face slant", value
, Qnil
);
3002 else if (EQ (keyword
, QCunderline
))
3007 to
[LFACE_UNDERLINE_INDEX
] = value
;
3009 add_to_log ("Illegal face underline", value
, Qnil
);
3011 else if (EQ (keyword
, QCoverline
))
3016 to
[LFACE_OVERLINE_INDEX
] = value
;
3018 add_to_log ("Illegal face overline", value
, Qnil
);
3020 else if (EQ (keyword
, QCstrike_through
))
3025 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3027 add_to_log ("Illegal face strike-through", value
, Qnil
);
3029 else if (EQ (keyword
, QCbox
))
3032 value
= make_number (1);
3033 if (INTEGERP (value
)
3037 to
[LFACE_BOX_INDEX
] = value
;
3039 add_to_log ("Illegal face box", value
, Qnil
);
3041 else if (EQ (keyword
, QCinverse_video
)
3042 || EQ (keyword
, QCreverse_video
))
3044 if (EQ (value
, Qt
) || NILP (value
))
3045 to
[LFACE_INVERSE_INDEX
] = value
;
3047 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3049 else if (EQ (keyword
, QCforeground
))
3051 if (STRINGP (value
))
3052 to
[LFACE_FOREGROUND_INDEX
] = value
;
3054 add_to_log ("Illegal face foreground", value
, Qnil
);
3056 else if (EQ (keyword
, QCbackground
))
3058 if (STRINGP (value
))
3059 to
[LFACE_BACKGROUND_INDEX
] = value
;
3061 add_to_log ("Illegal face background", value
, Qnil
);
3063 else if (EQ (keyword
, QCstipple
))
3065 #ifdef HAVE_X_WINDOWS
3066 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3067 if (!NILP (pixmap_p
))
3068 to
[LFACE_STIPPLE_INDEX
] = value
;
3070 add_to_log ("Illegal face stipple", value
, Qnil
);
3073 else if (EQ (keyword
, QCwidth
))
3076 && face_numeric_swidth (value
) >= 0)
3077 to
[LFACE_SWIDTH_INDEX
] = value
;
3079 add_to_log ("Illegal face width", value
, Qnil
);
3082 add_to_log ("Invalid attribute %s in face property",
3085 prop
= XCDR (XCDR (prop
));
3090 /* This is a list of face specs. Specifications at the
3091 beginning of the list take precedence over later
3092 specifications, so we have to merge starting with the
3093 last specification. */
3094 Lisp_Object next
= XCDR (prop
);
3096 merge_face_vector_with_property (f
, to
, next
);
3097 merge_face_vector_with_property (f
, to
, first
);
3102 /* PROP ought to be a face name. */
3103 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3105 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3107 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3112 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3113 Sinternal_make_lisp_face
, 1, 2, 0,
3114 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3115 If FACE was not known as a face before, create a new one.\n\
3116 If optional argument FRAME is specified, make a frame-local face\n\
3117 for that frame. Otherwise operate on the global face definition.\n\
3118 Value is a vector of face attributes.")
3120 Lisp_Object face
, frame
;
3122 Lisp_Object global_lface
, lface
;
3126 CHECK_SYMBOL (face
, 0);
3127 global_lface
= lface_from_face_name (NULL
, face
, 0);
3131 CHECK_LIVE_FRAME (frame
, 1);
3133 lface
= lface_from_face_name (f
, face
, 0);
3136 f
= NULL
, lface
= Qnil
;
3138 /* Add a global definition if there is none. */
3139 if (NILP (global_lface
))
3141 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3143 XVECTOR (global_lface
)->contents
[0] = Qface
;
3144 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3145 Vface_new_frame_defaults
);
3147 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3148 face id to Lisp face is given by the vector lface_id_to_name.
3149 The mapping from Lisp face to Lisp face id is given by the
3150 property `face' of the Lisp face name. */
3151 if (next_lface_id
== lface_id_to_name_size
)
3153 int new_size
= max (50, 2 * lface_id_to_name_size
);
3154 int sz
= new_size
* sizeof *lface_id_to_name
;
3155 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3156 lface_id_to_name_size
= new_size
;
3159 lface_id_to_name
[next_lface_id
] = face
;
3160 Fput (face
, Qface
, make_number (next_lface_id
));
3164 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3165 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3167 /* Add a frame-local definition. */
3172 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3174 XVECTOR (lface
)->contents
[0] = Qface
;
3175 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3178 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3179 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3182 lface
= global_lface
;
3184 xassert (LFACEP (lface
));
3185 check_lface (lface
);
3190 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3191 Sinternal_lisp_face_p
, 1, 2, 0,
3192 "Return non-nil if FACE names a face.\n\
3193 If optional second parameter FRAME is non-nil, check for the\n\
3194 existence of a frame-local face with name FACE on that frame.\n\
3195 Otherwise check for the existence of a global face.")
3197 Lisp_Object face
, frame
;
3203 CHECK_LIVE_FRAME (frame
, 1);
3204 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3207 lface
= lface_from_face_name (NULL
, face
, 0);
3213 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3214 Sinternal_copy_lisp_face
, 4, 4, 0,
3215 "Copy face FROM to TO.\n\
3216 If FRAME it t, copy the global face definition of FROM to the\n\
3217 global face definition of TO. Otherwise, copy the frame-local\n\
3218 definition of FROM on FRAME to the frame-local definition of TO\n\
3219 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3222 (from
, to
, frame
, new_frame
)
3223 Lisp_Object from
, to
, frame
, new_frame
;
3225 Lisp_Object lface
, copy
;
3227 CHECK_SYMBOL (from
, 0);
3228 CHECK_SYMBOL (to
, 1);
3229 if (NILP (new_frame
))
3234 /* Copy global definition of FROM. We don't make copies of
3235 strings etc. because 20.2 didn't do it either. */
3236 lface
= lface_from_face_name (NULL
, from
, 1);
3237 copy
= Finternal_make_lisp_face (to
, Qnil
);
3241 /* Copy frame-local definition of FROM. */
3242 CHECK_LIVE_FRAME (frame
, 2);
3243 CHECK_LIVE_FRAME (new_frame
, 3);
3244 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3245 copy
= Finternal_make_lisp_face (to
, new_frame
);
3248 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3249 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3255 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3256 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3257 "Set attribute ATTR of FACE to VALUE.\n\
3258 If optional argument FRAME is given, set the face attribute of face FACE\n\
3259 on that frame. If FRAME is t, set the attribute of the default for face\n\
3260 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3262 (face
, attr
, value
, frame
)
3263 Lisp_Object face
, attr
, value
, frame
;
3266 Lisp_Object old_value
= Qnil
;
3267 int font_related_attr_p
= 0;
3269 CHECK_SYMBOL (face
, 0);
3270 CHECK_SYMBOL (attr
, 1);
3272 face
= resolve_face_name (face
);
3274 /* Set lface to the Lisp attribute vector of FACE. */
3276 lface
= lface_from_face_name (NULL
, face
, 1);
3280 frame
= selected_frame
;
3282 CHECK_LIVE_FRAME (frame
, 3);
3283 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3285 /* If a frame-local face doesn't exist yet, create one. */
3287 lface
= Finternal_make_lisp_face (face
, frame
);
3290 if (EQ (attr
, QCfamily
))
3292 if (!UNSPECIFIEDP (value
))
3294 CHECK_STRING (value
, 3);
3295 if (XSTRING (value
)->size
== 0)
3296 signal_error ("Invalid face family", value
);
3298 old_value
= LFACE_FAMILY (lface
);
3299 LFACE_FAMILY (lface
) = value
;
3300 font_related_attr_p
= 1;
3302 else if (EQ (attr
, QCheight
))
3304 if (!UNSPECIFIEDP (value
))
3306 CHECK_NUMBER (value
, 3);
3307 if (XINT (value
) <= 0)
3308 signal_error ("Invalid face height", value
);
3310 old_value
= LFACE_HEIGHT (lface
);
3311 LFACE_HEIGHT (lface
) = value
;
3312 font_related_attr_p
= 1;
3314 else if (EQ (attr
, QCweight
))
3316 if (!UNSPECIFIEDP (value
))
3318 CHECK_SYMBOL (value
, 3);
3319 if (face_numeric_weight (value
) < 0)
3320 signal_error ("Invalid face weight", value
);
3322 old_value
= LFACE_WEIGHT (lface
);
3323 LFACE_WEIGHT (lface
) = value
;
3324 font_related_attr_p
= 1;
3326 else if (EQ (attr
, QCslant
))
3328 if (!UNSPECIFIEDP (value
))
3330 CHECK_SYMBOL (value
, 3);
3331 if (face_numeric_slant (value
) < 0)
3332 signal_error ("Invalid face slant", value
);
3334 old_value
= LFACE_SLANT (lface
);
3335 LFACE_SLANT (lface
) = value
;
3336 font_related_attr_p
= 1;
3338 else if (EQ (attr
, QCunderline
))
3340 if (!UNSPECIFIEDP (value
))
3341 if ((SYMBOLP (value
)
3343 && !EQ (value
, Qnil
))
3344 /* Underline color. */
3346 && XSTRING (value
)->size
== 0))
3347 signal_error ("Invalid face underline", value
);
3349 old_value
= LFACE_UNDERLINE (lface
);
3350 LFACE_UNDERLINE (lface
) = value
;
3352 else if (EQ (attr
, QCoverline
))
3354 if (!UNSPECIFIEDP (value
))
3355 if ((SYMBOLP (value
)
3357 && !EQ (value
, Qnil
))
3358 /* Overline color. */
3360 && XSTRING (value
)->size
== 0))
3361 signal_error ("Invalid face overline", value
);
3363 old_value
= LFACE_OVERLINE (lface
);
3364 LFACE_OVERLINE (lface
) = value
;
3366 else if (EQ (attr
, QCstrike_through
))
3368 if (!UNSPECIFIEDP (value
))
3369 if ((SYMBOLP (value
)
3371 && !EQ (value
, Qnil
))
3372 /* Strike-through color. */
3374 && XSTRING (value
)->size
== 0))
3375 signal_error ("Invalid face strike-through", value
);
3377 old_value
= LFACE_STRIKE_THROUGH (lface
);
3378 LFACE_STRIKE_THROUGH (lface
) = value
;
3380 else if (EQ (attr
, QCbox
))
3384 /* Allow t meaning a simple box of width 1 in foreground color
3387 value
= make_number (1);
3389 if (UNSPECIFIEDP (value
))
3391 else if (NILP (value
))
3393 else if (INTEGERP (value
))
3394 valid_p
= XINT (value
) > 0;
3395 else if (STRINGP (value
))
3396 valid_p
= XSTRING (value
)->size
> 0;
3397 else if (CONSP (value
))
3413 if (EQ (k
, QCline_width
))
3415 if (!INTEGERP (v
) || XINT (v
) <= 0)
3418 else if (EQ (k
, QCcolor
))
3420 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3423 else if (EQ (k
, QCstyle
))
3425 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3432 valid_p
= NILP (tem
);
3438 signal_error ("Invalid face box", value
);
3440 old_value
= LFACE_BOX (lface
);
3441 LFACE_BOX (lface
) = value
;
3443 else if (EQ (attr
, QCinverse_video
)
3444 || EQ (attr
, QCreverse_video
))
3446 if (!UNSPECIFIEDP (value
))
3448 CHECK_SYMBOL (value
, 3);
3449 if (!EQ (value
, Qt
) && !NILP (value
))
3450 signal_error ("Invalid inverse-video face attribute value", value
);
3452 old_value
= LFACE_INVERSE (lface
);
3453 LFACE_INVERSE (lface
) = value
;
3455 else if (EQ (attr
, QCforeground
))
3457 if (!UNSPECIFIEDP (value
))
3459 /* Don't check for valid color names here because it depends
3460 on the frame (display) whether the color will be valid
3461 when the face is realized. */
3462 CHECK_STRING (value
, 3);
3463 if (XSTRING (value
)->size
== 0)
3464 signal_error ("Empty foreground color value", value
);
3466 old_value
= LFACE_FOREGROUND (lface
);
3467 LFACE_FOREGROUND (lface
) = value
;
3469 else if (EQ (attr
, QCbackground
))
3471 if (!UNSPECIFIEDP (value
))
3473 /* Don't check for valid color names here because it depends
3474 on the frame (display) whether the color will be valid
3475 when the face is realized. */
3476 CHECK_STRING (value
, 3);
3477 if (XSTRING (value
)->size
== 0)
3478 signal_error ("Empty background color value", value
);
3480 old_value
= LFACE_BACKGROUND (lface
);
3481 LFACE_BACKGROUND (lface
) = value
;
3483 else if (EQ (attr
, QCstipple
))
3485 #ifdef HAVE_X_WINDOWS
3486 if (!UNSPECIFIEDP (value
)
3488 && NILP (Fbitmap_spec_p (value
)))
3489 signal_error ("Invalid stipple attribute", value
);
3490 old_value
= LFACE_STIPPLE (lface
);
3491 LFACE_STIPPLE (lface
) = value
;
3492 #endif /* HAVE_X_WINDOWS */
3494 else if (EQ (attr
, QCwidth
))
3496 if (!UNSPECIFIEDP (value
))
3498 CHECK_SYMBOL (value
, 3);
3499 if (face_numeric_swidth (value
) < 0)
3500 signal_error ("Invalid face width", value
);
3502 old_value
= LFACE_SWIDTH (lface
);
3503 LFACE_SWIDTH (lface
) = value
;
3504 font_related_attr_p
= 1;
3506 else if (EQ (attr
, QCfont
))
3508 #ifdef HAVE_X_WINDOWS
3509 /* Set font-related attributes of the Lisp face from an
3513 CHECK_STRING (value
, 3);
3515 f
= SELECTED_FRAME ();
3517 f
= check_x_frame (frame
);
3519 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3520 signal_error ("Invalid font name", value
);
3522 font_related_attr_p
= 1;
3523 #endif /* HAVE_X_WINDOWS */
3525 else if (EQ (attr
, QCbold
))
3527 old_value
= LFACE_WEIGHT (lface
);
3528 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3529 font_related_attr_p
= 1;
3531 else if (EQ (attr
, QCitalic
))
3533 old_value
= LFACE_SLANT (lface
);
3534 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3535 font_related_attr_p
= 1;
3538 signal_error ("Invalid face attribute name", attr
);
3540 /* Changing a named face means that all realized faces depending on
3541 that face are invalid. Since we cannot tell which realized faces
3542 depend on the face, make sure they are all removed. This is done
3543 by incrementing face_change_count. The next call to
3544 init_iterator will then free realized faces. */
3546 && (EQ (attr
, QCfont
)
3547 || NILP (Fequal (old_value
, value
))))
3549 ++face_change_count
;
3550 ++windows_or_buffers_changed
;
3553 #ifdef HAVE_X_WINDOWS
3556 && !UNSPECIFIEDP (value
)
3557 && NILP (Fequal (old_value
, value
)))
3563 if (EQ (face
, Qdefault
))
3565 /* Changed font-related attributes of the `default' face are
3566 reflected in changed `font' frame parameters. */
3567 if (font_related_attr_p
3568 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3569 set_font_frame_param (frame
, lface
);
3570 else if (EQ (attr
, QCforeground
))
3571 param
= Qforeground_color
;
3572 else if (EQ (attr
, QCbackground
))
3573 param
= Qbackground_color
;
3575 else if (EQ (face
, Qscroll_bar
))
3577 /* Changing the colors of `scroll-bar' sets frame parameters
3578 `scroll-bar-foreground' and `scroll-bar-background'. */
3579 if (EQ (attr
, QCforeground
))
3580 param
= Qscroll_bar_foreground
;
3581 else if (EQ (attr
, QCbackground
))
3582 param
= Qscroll_bar_background
;
3584 else if (EQ (face
, Qborder
))
3586 /* Changing background color of `border' sets frame parameter
3588 if (EQ (attr
, QCbackground
))
3589 param
= Qborder_color
;
3591 else if (EQ (face
, Qcursor
))
3593 /* Changing background color of `cursor' sets frame parameter
3595 if (EQ (attr
, QCbackground
))
3596 param
= Qcursor_color
;
3598 else if (EQ (face
, Qmouse
))
3600 /* Changing background color of `mouse' sets frame parameter
3602 if (EQ (attr
, QCbackground
))
3603 param
= Qmouse_color
;
3606 if (SYMBOLP (param
))
3607 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3610 #endif /* HAVE_X_WINDOWS */
3616 #ifdef HAVE_X_WINDOWS
3618 /* Set the `font' frame parameter of FRAME according to `default' face
3619 attributes LFACE. */
3622 set_font_frame_param (frame
, lface
)
3623 Lisp_Object frame
, lface
;
3625 struct frame
*f
= XFRAME (frame
);
3626 Lisp_Object frame_font
;
3630 /* Get FRAME's font parameter. */
3631 frame_font
= Fassq (Qfont
, f
->param_alist
);
3632 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3633 frame_font
= XCDR (frame_font
);
3635 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3638 /* Frame parameter is a fontset name. Modify the fontset so
3639 that all its fonts reflect face attributes LFACE. */
3641 struct fontset_info
*fontset_info
;
3643 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3645 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3646 if (fontset_info
->fontname
[charset
])
3648 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3650 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3651 build_string (font
), frame
);
3657 /* Frame parameter is an X font name. I believe this can
3658 only happen in unibyte mode. */
3659 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3660 -1, Vface_default_registry
);
3663 store_frame_param (f
, Qfont
, build_string (font
));
3670 /* Update the corresponding face when frame parameter PARAM on frame F
3671 has been assigned the value NEW_VALUE. */
3674 update_face_from_frame_parameter (f
, param
, new_value
)
3676 Lisp_Object param
, new_value
;
3680 /* If there are no faces yet, give up. This is the case when called
3681 from Fx_create_frame, and we do the necessary things later in
3682 face-set-after-frame-defaults. */
3683 if (NILP (f
->face_alist
))
3686 if (EQ (param
, Qforeground_color
))
3688 lface
= lface_from_face_name (f
, Qdefault
, 1);
3689 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3690 ? new_value
: Qunspecified
);
3691 realize_basic_faces (f
);
3693 else if (EQ (param
, Qbackground_color
))
3697 /* Changing the background color might change the background
3698 mode, so that we have to load new defface specs. Call
3699 frame-update-face-colors to do that. */
3700 XSETFRAME (frame
, f
);
3701 call1 (Qframe_update_face_colors
, frame
);
3703 lface
= lface_from_face_name (f
, Qdefault
, 1);
3704 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3705 ? new_value
: Qunspecified
);
3706 realize_basic_faces (f
);
3708 if (EQ (param
, Qborder_color
))
3710 lface
= lface_from_face_name (f
, Qborder
, 1);
3711 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3712 ? new_value
: Qunspecified
);
3714 else if (EQ (param
, Qcursor_color
))
3716 lface
= lface_from_face_name (f
, Qcursor
, 1);
3717 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3718 ? new_value
: Qunspecified
);
3720 else if (EQ (param
, Qmouse_color
))
3722 lface
= lface_from_face_name (f
, Qmouse
, 1);
3723 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3724 ? new_value
: Qunspecified
);
3729 /* Get the value of X resource RESOURCE, class CLASS for the display
3730 of frame FRAME. This is here because ordinary `x-get-resource'
3731 doesn't take a frame argument. */
3733 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3734 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3735 (resource
, class, frame
)
3736 Lisp_Object resource
, class, frame
;
3739 CHECK_STRING (resource
, 0);
3740 CHECK_STRING (class, 1);
3741 CHECK_LIVE_FRAME (frame
, 2);
3743 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3744 resource
, class, Qnil
, Qnil
);
3750 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3751 If VALUE is "on" or "true", return t. If VALUE is "off" or
3752 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3753 error; if SIGNAL_P is zero, return 0. */
3756 face_boolean_x_resource_value (value
, signal_p
)
3760 Lisp_Object result
= make_number (0);
3762 xassert (STRINGP (value
));
3764 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3765 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3767 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3768 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3770 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3771 result
= Qunspecified
;
3773 signal_error ("Invalid face attribute value from X resource", value
);
3779 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3780 Finternal_set_lisp_face_attribute_from_resource
,
3781 Sinternal_set_lisp_face_attribute_from_resource
,
3783 (face
, attr
, value
, frame
)
3784 Lisp_Object face
, attr
, value
, frame
;
3786 CHECK_SYMBOL (face
, 0);
3787 CHECK_SYMBOL (attr
, 1);
3788 CHECK_STRING (value
, 2);
3790 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3791 value
= Qunspecified
;
3792 else if (EQ (attr
, QCheight
))
3794 value
= Fstring_to_number (value
, make_number (10));
3795 if (XINT (value
) <= 0)
3796 signal_error ("Invalid face height from X resource", value
);
3798 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3799 value
= face_boolean_x_resource_value (value
, 1);
3800 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3801 value
= intern (XSTRING (value
)->data
);
3802 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3803 value
= face_boolean_x_resource_value (value
, 1);
3804 else if (EQ (attr
, QCunderline
)
3805 || EQ (attr
, QCoverline
)
3806 || EQ (attr
, QCstrike_through
)
3807 || EQ (attr
, QCbox
))
3809 Lisp_Object boolean_value
;
3811 /* If the result of face_boolean_x_resource_value is t or nil,
3812 VALUE does NOT specify a color. */
3813 boolean_value
= face_boolean_x_resource_value (value
, 0);
3814 if (SYMBOLP (boolean_value
))
3815 value
= boolean_value
;
3818 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3823 /***********************************************************************
3825 ***********************************************************************/
3827 #ifdef USE_X_TOOLKIT
3829 /* Structure used to pass X resources to functions called via
3830 XtApplyToWidgets. */
3841 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3842 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3845 /* Set widget W's X resources from P which points to an x_resources
3846 structure. If W is a cascade button, apply resources to W's
3850 xm_apply_resources (w
, p
)
3855 struct x_resources
*res
= (struct x_resources
*) p
;
3857 XtSetValues (w
, res
->av
, res
->ac
);
3858 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3861 XtSetValues (submenu
, res
->av
, res
->ac
);
3862 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3867 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3868 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3871 1. Setting the XmNfontList resource leads to an infinite loop
3872 somewhere in LessTif. */
3875 xm_set_menu_resources_from_menu_face (f
, widget
)
3885 lface
= lface_from_face_name (f
, Qmenu
, 1);
3886 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3888 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3890 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3894 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3896 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3900 /* If any font-related attribute of `menu' is set, set the font. */
3902 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3903 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3904 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3905 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3906 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3908 #if 0 /* Setting the font leads to an infinite loop somewhere
3909 in LessTif during geometry computation. */
3911 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3912 fl
= XmFontListAppendEntry (NULL
, fe
);
3913 XtSetArg (av
[ac
], XmNfontList
, fl
);
3918 xassert (ac
<= sizeof av
/ sizeof *av
);
3922 struct x_resources res
;
3924 XtSetValues (widget
, av
, ac
);
3925 res
.av
= av
, res
.ac
= ac
;
3926 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3928 XmFontListFree (fl
);
3933 #endif /* USE_MOTIF */
3937 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3938 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3941 /* Set widget W's resources from P which points to an x_resources
3945 xl_apply_resources (widget
, p
)
3949 struct x_resources
*res
= (struct x_resources
*) p
;
3950 XtSetValues (widget
, res
->av
, res
->ac
);
3954 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3955 This is the Lucid version. */
3958 xl_set_menu_resources_from_menu_face (f
, widget
)
3967 lface
= lface_from_face_name (f
, Qmenu
, 1);
3968 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3970 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3972 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3976 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3978 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3983 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3984 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3985 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3986 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3987 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3989 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3995 struct x_resources res
;
3997 XtSetValues (widget
, av
, ac
);
3999 /* We must do children here in case we're handling a pop-up menu
4000 in which case WIDGET is a popup shell. XtApplyToWidgets
4001 is a function from lwlib. */
4002 res
.av
= av
, res
.ac
= ac
;
4003 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4007 #endif /* USE_LUCID */
4010 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4013 x_set_menu_resources_from_menu_face (f
, widget
)
4017 /* Realized faces may have been removed on frame F, e.g. because of
4018 face attribute changes. Recompute them, if necessary, since we
4019 will need the `menu' face. */
4020 if (f
->face_cache
->used
== 0)
4021 recompute_basic_faces (f
);
4024 xl_set_menu_resources_from_menu_face (f
, widget
);
4027 xm_set_menu_resources_from_menu_face (f
, widget
);
4031 #endif /* USE_X_TOOLKIT */
4033 #endif /* HAVE_X_WINDOWS */
4037 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4038 Sinternal_get_lisp_face_attribute
,
4040 "Return face attribute KEYWORD of face SYMBOL.\n\
4041 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4042 face attribute name, signal an error.\n\
4043 If the optional argument FRAME is given, report on face FACE in that\n\
4044 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4045 frames). If FRAME is omitted or nil, use the selected frame.")
4046 (symbol
, keyword
, frame
)
4047 Lisp_Object symbol
, keyword
, frame
;
4049 Lisp_Object lface
, value
= Qnil
;
4051 CHECK_SYMBOL (symbol
, 0);
4052 CHECK_SYMBOL (keyword
, 1);
4055 lface
= lface_from_face_name (NULL
, symbol
, 1);
4059 frame
= selected_frame
;
4060 CHECK_LIVE_FRAME (frame
, 2);
4061 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4064 if (EQ (keyword
, QCfamily
))
4065 value
= LFACE_FAMILY (lface
);
4066 else if (EQ (keyword
, QCheight
))
4067 value
= LFACE_HEIGHT (lface
);
4068 else if (EQ (keyword
, QCweight
))
4069 value
= LFACE_WEIGHT (lface
);
4070 else if (EQ (keyword
, QCslant
))
4071 value
= LFACE_SLANT (lface
);
4072 else if (EQ (keyword
, QCunderline
))
4073 value
= LFACE_UNDERLINE (lface
);
4074 else if (EQ (keyword
, QCoverline
))
4075 value
= LFACE_OVERLINE (lface
);
4076 else if (EQ (keyword
, QCstrike_through
))
4077 value
= LFACE_STRIKE_THROUGH (lface
);
4078 else if (EQ (keyword
, QCbox
))
4079 value
= LFACE_BOX (lface
);
4080 else if (EQ (keyword
, QCinverse_video
)
4081 || EQ (keyword
, QCreverse_video
))
4082 value
= LFACE_INVERSE (lface
);
4083 else if (EQ (keyword
, QCforeground
))
4084 value
= LFACE_FOREGROUND (lface
);
4085 else if (EQ (keyword
, QCbackground
))
4086 value
= LFACE_BACKGROUND (lface
);
4087 else if (EQ (keyword
, QCstipple
))
4088 value
= LFACE_STIPPLE (lface
);
4089 else if (EQ (keyword
, QCwidth
))
4090 value
= LFACE_SWIDTH (lface
);
4092 signal_error ("Invalid face attribute name", keyword
);
4098 DEFUN ("internal-lisp-face-attribute-values",
4099 Finternal_lisp_face_attribute_values
,
4100 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4101 "Return a list of valid discrete values for face attribute ATTR.\n\
4102 Value is nil if ATTR doesn't have a discrete set of valid values.")
4106 Lisp_Object result
= Qnil
;
4108 CHECK_SYMBOL (attr
, 0);
4110 if (EQ (attr
, QCweight
)
4111 || EQ (attr
, QCslant
)
4112 || EQ (attr
, QCwidth
))
4114 /* Extract permissible symbols from tables. */
4115 struct table_entry
*table
;
4118 if (EQ (attr
, QCweight
))
4119 table
= weight_table
, dim
= DIM (weight_table
);
4120 else if (EQ (attr
, QCslant
))
4121 table
= slant_table
, dim
= DIM (slant_table
);
4123 table
= swidth_table
, dim
= DIM (swidth_table
);
4125 for (i
= 0; i
< dim
; ++i
)
4127 Lisp_Object symbol
= *table
[i
].symbol
;
4128 Lisp_Object tail
= result
;
4131 && !EQ (XCAR (tail
), symbol
))
4135 result
= Fcons (symbol
, result
);
4138 else if (EQ (attr
, QCunderline
))
4139 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4140 else if (EQ (attr
, QCoverline
))
4141 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4142 else if (EQ (attr
, QCstrike_through
))
4143 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4144 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4145 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4151 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4152 Sinternal_merge_in_global_face
, 2, 2, 0,
4153 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4155 Lisp_Object face
, frame
;
4157 Lisp_Object global_lface
, local_lface
;
4158 CHECK_LIVE_FRAME (frame
, 1);
4159 global_lface
= lface_from_face_name (NULL
, face
, 1);
4160 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4161 if (NILP (local_lface
))
4162 local_lface
= Finternal_make_lisp_face (face
, frame
);
4163 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4164 XVECTOR (local_lface
)->contents
);
4169 /* The following function is implemented for compatibility with 20.2.
4170 The function is used in x-resolve-fonts when it is asked to
4171 return fonts with the same size as the font of a face. This is
4172 done in fontset.el. */
4174 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4175 "Return the font name of face FACE, or nil if it is unspecified.\n\
4176 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4177 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4178 The font default for a face is either nil, or a list\n\
4179 of the form (bold), (italic) or (bold italic).\n\
4180 If FRAME is omitted or nil, use the selected frame.")
4182 Lisp_Object face
, frame
;
4186 Lisp_Object result
= Qnil
;
4187 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4189 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4190 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4191 result
= Fcons (Qbold
, result
);
4193 if (!NILP (LFACE_SLANT (lface
))
4194 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4195 result
= Fcons (Qitalic
, result
);
4201 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4202 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4203 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4204 return build_string (face
->font_name
);
4209 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4210 all attributes are `equal'. Tries to be fast because this function
4211 is called quite often. */
4214 lface_equal_p (v1
, v2
)
4215 Lisp_Object
*v1
, *v2
;
4219 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4221 Lisp_Object a
= v1
[i
];
4222 Lisp_Object b
= v2
[i
];
4224 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4225 and the other is specified. */
4226 equal_p
= XTYPE (a
) == XTYPE (b
);
4235 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4236 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4237 XSTRING (a
)->size
) == 0);
4246 equal_p
= !NILP (Fequal (a
, b
));
4256 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4257 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4258 "True if FACE1 and FACE2 are equal.\n\
4259 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4260 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4261 If FRAME is omitted or nil, use the selected frame.")
4262 (face1
, face2
, frame
)
4263 Lisp_Object face1
, face2
, frame
;
4267 Lisp_Object lface1
, lface2
;
4272 /* Don't use check_x_frame here because this function is called
4273 before X frames exist. At that time, if FRAME is nil,
4274 selected_frame will be used which is the frame dumped with
4275 Emacs. That frame is not an X frame. */
4276 f
= frame_or_selected_frame (frame
, 2);
4278 lface1
= lface_from_face_name (NULL
, face1
, 1);
4279 lface2
= lface_from_face_name (NULL
, face2
, 1);
4280 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4281 XVECTOR (lface2
)->contents
);
4282 return equal_p
? Qt
: Qnil
;
4286 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4287 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4288 "True if FACE has no attribute specified.\n\
4289 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4290 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4291 If FRAME is omitted or nil, use the selected frame.")
4293 Lisp_Object face
, frame
;
4300 frame
= selected_frame
;
4301 CHECK_LIVE_FRAME (frame
, 0);
4305 lface
= lface_from_face_name (NULL
, face
, 1);
4307 lface
= lface_from_face_name (f
, face
, 1);
4309 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4310 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4313 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4317 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4319 "Return an alist of frame-local faces defined on FRAME.\n\
4320 For internal use only.")
4324 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4325 return f
->face_alist
;
4329 /* Return a hash code for Lisp string STRING with case ignored. Used
4330 below in computing a hash value for a Lisp face. */
4332 static INLINE
unsigned
4333 hash_string_case_insensitive (string
)
4338 xassert (STRINGP (string
));
4339 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4340 hash
= (hash
<< 1) ^ tolower (*s
);
4345 /* Return a hash code for face attribute vector V. */
4347 static INLINE
unsigned
4351 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4352 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4353 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4354 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4355 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4356 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4357 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4361 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4362 considering charsets/registries). They do if they specify the same
4363 family, point size, weight, width and slant. Both LFACE1 and
4364 LFACE2 must be fully-specified. */
4367 lface_same_font_attributes_p (lface1
, lface2
)
4368 Lisp_Object
*lface1
, *lface2
;
4370 xassert (lface_fully_specified_p (lface1
)
4371 && lface_fully_specified_p (lface2
));
4372 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4373 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4374 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4375 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4376 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4377 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4378 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4383 /***********************************************************************
4385 ***********************************************************************/
4387 /* Allocate and return a new realized face for Lisp face attribute
4388 vector ATTR, charset CHARSET, and registry REGISTRY. */
4390 static struct face
*
4391 make_realized_face (attr
, charset
, registry
)
4394 Lisp_Object registry
;
4396 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4397 bzero (face
, sizeof *face
);
4398 face
->charset
= charset
;
4399 face
->registry
= registry
;
4400 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4405 /* Free realized face FACE, including its X resources. FACE may
4409 free_realized_face (f
, face
)
4415 #ifdef HAVE_X_WINDOWS
4420 x_free_gc (f
, face
->gc
);
4424 free_face_colors (f
, face
);
4425 x_destroy_bitmap (f
, face
->stipple
);
4427 #endif /* HAVE_X_WINDOWS */
4434 /* Prepare face FACE for subsequent display on frame F. This
4435 allocated GCs if they haven't been allocated yet or have been freed
4436 by clearing the face cache. */
4439 prepare_face_for_display (f
, face
)
4443 #ifdef HAVE_X_WINDOWS
4444 xassert (FRAME_X_P (f
));
4449 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4451 xgcv
.foreground
= face
->foreground
;
4452 xgcv
.background
= face
->background
;
4453 xgcv
.graphics_exposures
= False
;
4455 /* The font of FACE may be null if we couldn't load it. */
4458 xgcv
.font
= face
->font
->fid
;
4465 xgcv
.fill_style
= FillOpaqueStippled
;
4466 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4467 mask
|= GCFillStyle
| GCStipple
;
4470 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4477 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4478 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4479 ISO8859-1 if the ASCII face suffices. */
4482 face_suitable_for_iso8859_1_p (face
)
4485 int len
= strlen (face
->font_name
);
4486 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4490 /* Value is non-zero if FACE is suitable for displaying characters
4491 of CHARSET. CHARSET < 0 means unibyte text. */
4494 face_suitable_for_charset_p (face
, charset
)
4502 if (EQ (face
->registry
, Vface_default_registry
)
4503 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4506 else if (face
->charset
== charset
)
4508 else if (face
->charset
== CHARSET_ASCII
4509 && charset
== charset_latin_iso8859_1
)
4510 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4511 else if (face
->charset
== charset_latin_iso8859_1
4512 && charset
== CHARSET_ASCII
)
4520 /***********************************************************************
4522 ***********************************************************************/
4524 /* Return a new face cache for frame F. */
4526 static struct face_cache
*
4530 struct face_cache
*c
;
4533 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4534 bzero (c
, sizeof *c
);
4535 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4536 c
->buckets
= (struct face
**) xmalloc (size
);
4537 bzero (c
->buckets
, size
);
4539 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4545 /* Clear out all graphics contexts for all realized faces, except for
4546 the basic faces. This should be done from time to time just to avoid
4547 keeping too many graphics contexts that are no longer needed. */
4551 struct face_cache
*c
;
4553 if (c
&& FRAME_X_P (c
->f
))
4555 #ifdef HAVE_X_WINDOWS
4557 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4559 struct face
*face
= c
->faces_by_id
[i
];
4560 if (face
&& face
->gc
)
4562 x_free_gc (c
->f
, face
->gc
);
4566 #endif /* HAVE_X_WINDOWS */
4571 /* Free all realized faces in face cache C, including basic faces. C
4572 may be null. If faces are freed, make sure the frame's current
4573 matrix is marked invalid, so that a display caused by an expose
4574 event doesn't try to use faces we destroyed. */
4577 free_realized_faces (c
)
4578 struct face_cache
*c
;
4583 struct frame
*f
= c
->f
;
4585 for (i
= 0; i
< c
->used
; ++i
)
4587 free_realized_face (f
, c
->faces_by_id
[i
]);
4588 c
->faces_by_id
[i
] = NULL
;
4592 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4593 bzero (c
->buckets
, size
);
4595 /* Must do a thorough redisplay the next time. Mark current
4596 matrices as invalid because they will reference faces freed
4597 above. This function is also called when a frame is
4598 destroyed. In this case, the root window of F is nil. */
4599 if (WINDOWP (f
->root_window
))
4601 clear_current_matrices (f
);
4602 ++windows_or_buffers_changed
;
4608 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4609 This is done after attributes of a named face have been changed,
4610 because we can't tell which realized faces depend on that face. */
4613 free_all_realized_faces (frame
)
4619 FOR_EACH_FRAME (rest
, frame
)
4620 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4623 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4627 /* Free face cache C and faces in it, including their X resources. */
4631 struct face_cache
*c
;
4635 free_realized_faces (c
);
4637 xfree (c
->faces_by_id
);
4643 /* Cache realized face FACE in face cache C. HASH is the hash value
4644 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4645 collision list of the face hash table of C. This is done because
4646 otherwise lookup_face would find FACE for every charset, even if
4647 faces with the same attributes but for specific charsets exist. */
4650 cache_face (c
, face
, hash
)
4651 struct face_cache
*c
;
4655 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4659 if (face
->fontset
>= 0)
4661 struct face
*last
= c
->buckets
[i
];
4672 c
->buckets
[i
] = face
;
4673 face
->prev
= face
->next
= NULL
;
4679 face
->next
= c
->buckets
[i
];
4681 face
->next
->prev
= face
;
4682 c
->buckets
[i
] = face
;
4685 /* Find a free slot in C->faces_by_id and use the index of the free
4686 slot as FACE->id. */
4687 for (i
= 0; i
< c
->used
; ++i
)
4688 if (c
->faces_by_id
[i
] == NULL
)
4692 /* Maybe enlarge C->faces_by_id. */
4693 if (i
== c
->used
&& c
->used
== c
->size
)
4695 int new_size
= 2 * c
->size
;
4696 int sz
= new_size
* sizeof *c
->faces_by_id
;
4697 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4702 /* Check that FACE got a unique id. */
4707 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4708 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4714 #endif /* GLYPH_DEBUG */
4716 c
->faces_by_id
[i
] = face
;
4722 /* Remove face FACE from cache C. */
4725 uncache_face (c
, face
)
4726 struct face_cache
*c
;
4729 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4732 face
->prev
->next
= face
->next
;
4734 c
->buckets
[i
] = face
->next
;
4737 face
->next
->prev
= face
->prev
;
4739 c
->faces_by_id
[face
->id
] = NULL
;
4740 if (face
->id
== c
->used
)
4745 /* Look up a realized face with face attributes ATTR in the face cache
4746 of frame F. The face will be used to display characters of
4747 CHARSET. CHARSET < 0 means the face will be used to display
4748 unibyte text. The value of face-default-registry is used to choose
4749 a font for the face in that case. Value is the ID of the face
4750 found. If no suitable face is found, realize a new one. */
4753 lookup_face (f
, attr
, charset
)
4758 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4763 xassert (c
!= NULL
);
4764 check_lface_attrs (attr
);
4766 /* Look up ATTR in the face cache. */
4767 hash
= lface_hash (attr
);
4768 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4770 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4771 if (face
->hash
== hash
4772 && (!FRAME_WINDOW_P (f
)
4773 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4774 && lface_equal_p (face
->lface
, attr
))
4777 /* If not found, realize a new face. */
4780 face
= realize_face (c
, attr
, charset
);
4781 cache_face (c
, face
, hash
);
4785 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4787 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4788 #endif /* GLYPH_DEBUG */
4794 /* Return the face id of the realized face for named face SYMBOL on
4795 frame F suitable for displaying characters from CHARSET. CHARSET <
4796 0 means unibyte text. */
4799 lookup_named_face (f
, symbol
, charset
)
4804 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4805 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4806 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4808 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4809 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4810 merge_face_vectors (symbol_attrs
, attrs
);
4811 return lookup_face (f
, attrs
, charset
);
4815 /* Return the ID of the realized ASCII face of Lisp face with ID
4816 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4819 ascii_face_of_lisp_face (f
, lface_id
)
4825 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4827 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4828 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4837 /* Return a face for charset ASCII that is like the face with id
4838 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4839 STEPS < 0 means larger. Value is the id of the face. */
4842 smaller_face (f
, face_id
, steps
)
4846 #ifdef HAVE_X_WINDOWS
4848 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4849 int pt
, last_pt
, last_height
;
4852 struct face
*new_face
;
4854 /* If not called for an X frame, just return the original face. */
4855 if (FRAME_TERMCAP_P (f
))
4858 /* Try in increments of 1/2 pt. */
4859 delta
= steps
< 0 ? 5 : -5;
4860 steps
= abs (steps
);
4862 face
= FACE_FROM_ID (f
, face_id
);
4863 bcopy (face
->lface
, attrs
, sizeof attrs
);
4864 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4865 new_face_id
= face_id
;
4866 last_height
= FONT_HEIGHT (face
->font
);
4870 /* Give up if we cannot find a font within 10pt. */
4871 && abs (last_pt
- pt
) < 100)
4873 /* Look up a face for a slightly smaller/larger font. */
4875 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4876 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4877 new_face
= FACE_FROM_ID (f
, new_face_id
);
4879 /* If height changes, count that as one step. */
4880 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4883 last_height
= FONT_HEIGHT (new_face
->font
);
4890 #else /* not HAVE_X_WINDOWS */
4894 #endif /* not HAVE_X_WINDOWS */
4898 /* Return a face for charset ASCII that is like the face with id
4899 FACE_ID on frame F, but has height HEIGHT. */
4902 face_with_height (f
, face_id
, height
)
4907 #ifdef HAVE_X_WINDOWS
4909 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4911 if (FRAME_TERMCAP_P (f
)
4915 face
= FACE_FROM_ID (f
, face_id
);
4916 bcopy (face
->lface
, attrs
, sizeof attrs
);
4917 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4918 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4919 #endif /* HAVE_X_WINDOWS */
4924 /* Return the face id of the realized face for named face SYMBOL on
4925 frame F suitable for displaying characters from CHARSET (CHARSET <
4926 0 means unibyte text), and use attributes of the face FACE_ID for
4927 attributes that aren't completely specified by SYMBOL. This is
4928 like lookup_named_face, except that the default attributes come
4929 from FACE_ID, not from the default face. FACE_ID is assumed to
4930 be already realized. */
4933 lookup_derived_face (f
, symbol
, charset
, face_id
)
4939 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4940 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4941 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4946 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4947 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4948 merge_face_vectors (symbol_attrs
, attrs
);
4949 return lookup_face (f
, attrs
, charset
);
4954 /***********************************************************************
4956 ***********************************************************************/
4958 DEFUN ("internal-set-font-selection-order",
4959 Finternal_set_font_selection_order
,
4960 Sinternal_set_font_selection_order
, 1, 1, 0,
4961 "Set font selection order for face font selection to ORDER.\n\
4962 ORDER must be a list of length 4 containing the symbols `:width',\n\
4963 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4964 first in ORDER are matched first, e.g. if `:height' appears before\n\
4965 `:weight' in ORDER, font selection first tries to find a font with\n\
4966 a suitable height, and then tries to match the font weight.\n\
4975 CHECK_LIST (order
, 0);
4976 bzero (indices
, sizeof indices
);
4980 CONSP (list
) && i
< DIM (indices
);
4981 list
= XCDR (list
), ++i
)
4983 Lisp_Object attr
= XCAR (list
);
4986 if (EQ (attr
, QCwidth
))
4988 else if (EQ (attr
, QCheight
))
4989 xlfd
= XLFD_POINT_SIZE
;
4990 else if (EQ (attr
, QCweight
))
4992 else if (EQ (attr
, QCslant
))
4997 if (indices
[i
] != 0)
5003 || i
!= DIM (indices
)
5008 signal_error ("Invalid font sort order", order
);
5010 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5012 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5013 free_all_realized_faces (Qnil
);
5020 DEFUN ("internal-set-alternative-font-family-alist",
5021 Finternal_set_alternative_font_family_alist
,
5022 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5023 "Define alternative font families to try in face font selection.\n\
5024 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5025 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5026 be found. Value is ALIST.")
5030 CHECK_LIST (alist
, 0);
5031 Vface_alternative_font_family_alist
= alist
;
5032 free_all_realized_faces (Qnil
);
5037 #ifdef HAVE_X_WINDOWS
5039 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5040 Value is nil if not successful. */
5043 deduce_unibyte_registry (f
, font_name
)
5047 struct font_name font
;
5048 Lisp_Object registry
= Qnil
;
5050 font
.name
= STRDUPA (font_name
);
5051 if (split_font_name (f
, &font
, 0))
5055 /* Extract registry and encoding. */
5056 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5057 + strlen (font
.fields
[XLFD_ENCODING
])
5059 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5060 strcat (buffer
, "-");
5061 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5062 registry
= build_string (buffer
);
5069 /* Value is non-zero if FONT is the name of a scalable font. The
5070 X11R6 XLFD spec says that point size, pixel size, and average width
5071 are zero for scalable fonts. Intlfonts contain at least one
5072 scalable font ("*-muleindian-1") for which this isn't true, so we
5073 just test average width. */
5076 font_scalable_p (font
)
5077 struct font_name
*font
;
5079 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5080 return *s
== '0' && *(s
+ 1) == '\0';
5084 /* Value is non-zero if FONT1 is a better match for font attributes
5085 VALUES than FONT2. VALUES is an array of face attribute values in
5086 font sort order. COMPARE_PT_P zero means don't compare point
5090 better_font_p (values
, font1
, font2
, compare_pt_p
)
5092 struct font_name
*font1
, *font2
;
5097 for (i
= 0; i
< 4; ++i
)
5099 int xlfd_idx
= font_sort_order
[i
];
5101 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5103 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5104 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5106 if (delta1
> delta2
)
5108 else if (delta1
< delta2
)
5112 /* The difference may be equal because, e.g., the face
5113 specifies `italic' but we have only `regular' and
5114 `oblique'. Prefer `oblique' in this case. */
5115 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5116 && font1
->numeric
[xlfd_idx
] > values
[i
]
5117 && font2
->numeric
[xlfd_idx
] < values
[i
])
5129 /* Value is non-zero if FONT is an exact match for face attributes in
5130 SPECIFIED. SPECIFIED is an array of face attribute values in font
5134 exact_face_match_p (specified
, font
)
5136 struct font_name
*font
;
5140 for (i
= 0; i
< 4; ++i
)
5141 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5148 /* Value is the name of a scaled font, generated from scalable font
5149 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5150 Value is allocated from heap. */
5153 build_scalable_font_name (f
, font
, specified_pt
)
5155 struct font_name
*font
;
5158 char point_size
[20], pixel_size
[20];
5160 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5163 /* If scalable font is for a specific resolution, compute
5164 the point size we must specify from the resolution of
5165 the display and the specified resolution of the font. */
5166 if (font
->numeric
[XLFD_RESY
] != 0)
5168 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5169 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5174 pixel_value
= resy
/ 720.0 * pt
;
5177 /* Set point size of the font. */
5178 sprintf (point_size
, "%d", (int) pt
);
5179 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5180 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5182 /* Set pixel size. */
5183 sprintf (pixel_size
, "%d", pixel_value
);
5184 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5185 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5187 /* If font doesn't specify its resolution, use the
5188 resolution of the display. */
5189 if (font
->numeric
[XLFD_RESY
] == 0)
5192 sprintf (buffer
, "%d", (int) resy
);
5193 font
->fields
[XLFD_RESY
] = buffer
;
5194 font
->numeric
[XLFD_RESY
] = resy
;
5197 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5200 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5201 sprintf (buffer
, "%d", resx
);
5202 font
->fields
[XLFD_RESX
] = buffer
;
5203 font
->numeric
[XLFD_RESX
] = resx
;
5206 return build_font_name (font
);
5210 /* Value is non-zero if we are allowed to use scalable font FONT. We
5211 can't run a Lisp function here since this function may be called
5212 with input blocked. */
5215 may_use_scalable_font_p (font
, name
)
5216 struct font_name
*font
;
5219 if (EQ (Vscalable_fonts_allowed
, Qt
))
5221 else if (CONSP (Vscalable_fonts_allowed
))
5223 Lisp_Object tail
, regexp
;
5225 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5227 regexp
= XCAR (tail
);
5228 if (STRINGP (regexp
)
5229 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5237 #endif /* SCALABLE_FONTS != 0 */
5240 /* Return the name of the best matching font for face attributes
5241 ATTRS in the array of font_name structures FONTS which contains
5242 NFONTS elements. Value is a font name which is allocated from
5243 the heap. FONTS is freed by this function. */
5246 best_matching_font (f
, attrs
, fonts
, nfonts
)
5249 struct font_name
*fonts
;
5253 struct font_name
*best
;
5261 /* Make specified font attributes available in `specified',
5262 indexed by sort order. */
5263 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5265 int xlfd_idx
= font_sort_order
[i
];
5267 if (xlfd_idx
== XLFD_SWIDTH
)
5268 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5269 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5270 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5271 else if (xlfd_idx
== XLFD_WEIGHT
)
5272 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5273 else if (xlfd_idx
== XLFD_SLANT
)
5274 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5284 /* Start with the first non-scalable font in the list. */
5285 for (i
= 0; i
< nfonts
; ++i
)
5286 if (!font_scalable_p (fonts
+ i
))
5289 /* Find the best match among the non-scalable fonts. */
5294 for (i
= 1; i
< nfonts
; ++i
)
5295 if (!font_scalable_p (fonts
+ i
)
5296 && better_font_p (specified
, fonts
+ i
, best
, 1))
5300 exact_p
= exact_face_match_p (specified
, best
);
5309 /* Unless we found an exact match among non-scalable fonts, see if
5310 we can find a better match among scalable fonts. */
5313 /* A scalable font is better if
5315 1. its weight, slant, swidth attributes are better, or.
5317 2. the best non-scalable font doesn't have the required
5318 point size, and the scalable fonts weight, slant, swidth
5321 int non_scalable_has_exact_height_p
;
5323 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5324 non_scalable_has_exact_height_p
= 1;
5326 non_scalable_has_exact_height_p
= 0;
5328 for (i
= 0; i
< nfonts
; ++i
)
5329 if (font_scalable_p (fonts
+ i
))
5332 || better_font_p (specified
, fonts
+ i
, best
, 0)
5333 || (!non_scalable_has_exact_height_p
5334 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5339 if (font_scalable_p (best
))
5340 font_name
= build_scalable_font_name (f
, best
, pt
);
5342 font_name
= build_font_name (best
);
5344 #else /* !SCALABLE_FONTS */
5346 /* Find the best non-scalable font. */
5349 for (i
= 1; i
< nfonts
; ++i
)
5351 xassert (!font_scalable_p (fonts
+ i
));
5352 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5356 font_name
= build_font_name (best
);
5358 #endif /* !SCALABLE_FONTS */
5360 /* Free font_name structures. */
5361 free_font_names (fonts
, nfonts
);
5367 /* Try to get a list of fonts on frame F with font family FAMILY and
5368 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5369 of font_name structures for the fonts matched. Value is the number
5373 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5376 char *pattern
, *family
, *registry
;
5377 struct font_name
**fonts
;
5382 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5384 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5390 /* Try alternative font families from
5391 Vface_alternative_font_family_alist. */
5392 alter
= Fassoc (build_string (family
),
5393 Vface_alternative_font_family_alist
);
5395 for (alter
= XCDR (alter
);
5396 CONSP (alter
) && nfonts
== 0;
5397 alter
= XCDR (alter
))
5399 if (STRINGP (XCAR (alter
)))
5401 family
= LSTRDUPA (XCAR (alter
));
5402 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5406 /* Try font family of the default face or "fixed". */
5409 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5411 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5414 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5417 /* Try any family with the given registry. */
5419 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5426 /* Return the registry and encoding pattern that fonts for CHARSET
5427 should match. Value is allocated from the heap. */
5430 x_charset_registry (charset
)
5433 Lisp_Object prop
, charset_plist
;
5436 /* Get registry and encoding from the charset's plist. */
5437 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5438 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5442 if (index (XSTRING (prop
)->data
, '-'))
5443 registry
= xstrdup (XSTRING (prop
)->data
);
5446 /* If registry doesn't contain a `-', make it a pattern. */
5447 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5448 strcpy (registry
, XSTRING (prop
)->data
);
5449 strcat (registry
, "*-*");
5452 else if (STRINGP (Vface_default_registry
))
5453 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5455 registry
= xstrdup ("iso8859-1");
5461 /* Return the fontset id of the fontset name or alias name given by
5462 the family attribute of ATTRS on frame F. Value is -1 if the
5463 family attribute of ATTRS doesn't name a fontset. */
5466 face_fontset (f
, attrs
)
5470 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5473 name
= Fquery_fontset (name
, Qnil
);
5477 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5483 /* Get the font to use for the face realizing the fully-specified Lisp
5484 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5485 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5486 in this case. Value is the font name which is allocated from the
5487 heap (which means that it must be freed eventually). */
5490 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5494 Lisp_Object unibyte_registry
;
5496 struct font_name
*fonts
;
5500 /* ATTRS must be fully-specified. */
5501 xassert (lface_fully_specified_p (attrs
));
5503 if (STRINGP (unibyte_registry
))
5504 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5506 registry
= x_charset_registry (charset
);
5508 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5510 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5514 /* Choose a font to use on frame F to display CHARSET using FONTSET
5515 with Lisp face attributes specified by ATTRS. CHARSET may be any
5516 valid charset. CHARSET < 0 means unibyte text. If the fontset
5517 doesn't contain a font pattern for charset, use the pattern for
5518 CHARSET_ASCII. Value is the font name which is allocated from the
5519 heap and must be freed by the caller. */
5522 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5525 int fontset
, charset
;
5528 char *font_name
= NULL
;
5529 struct fontset_info
*fontset_info
;
5530 struct font_name
*fonts
;
5533 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5535 /* For unibyte text, use the ASCII font of the fontset. Using the
5536 ASCII font seems to be the most reasonable thing we can do in
5539 charset
= CHARSET_ASCII
;
5541 /* Get the font name pattern to use for CHARSET from the fontset. */
5542 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5543 pattern
= fontset_info
->fontname
[charset
];
5545 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5548 /* Get a list of fonts matching that pattern and choose the
5549 best match for the specified face attributes from it. */
5550 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5551 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5555 #endif /* HAVE_X_WINDOWS */
5559 /***********************************************************************
5561 ***********************************************************************/
5563 /* Realize basic faces on frame F. Value is zero if frame parameters
5564 of F don't contain enough information needed to realize the default
5568 realize_basic_faces (f
)
5573 if (realize_default_face (f
))
5575 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5576 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5577 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5578 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5579 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5580 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5581 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5582 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5583 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5591 /* Realize the default face on frame F. If the face is not fully
5592 specified, make it fully-specified. Attributes of the default face
5593 that are not explicitly specified are taken from frame parameters. */
5596 realize_default_face (f
)
5599 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5601 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5602 Lisp_Object unibyte_registry
;
5603 Lisp_Object frame_font
;
5607 /* If the `default' face is not yet known, create it. */
5608 lface
= lface_from_face_name (f
, Qdefault
, 0);
5612 XSETFRAME (frame
, f
);
5613 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5616 #ifdef HAVE_X_WINDOWS
5619 /* Set frame_font to the value of the `font' frame parameter. */
5620 frame_font
= Fassq (Qfont
, f
->param_alist
);
5621 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5622 frame_font
= XCDR (frame_font
);
5624 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5627 /* If frame_font is a fontset name, don't use that for
5628 determining font-related attributes of the default face
5629 because it is just an artificial name. Use the ASCII font of
5630 the fontset, instead. */
5631 struct font_info
*font_info
;
5632 struct font_name font
;
5635 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5639 /* Set weight etc. from the ASCII font. */
5640 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5643 /* Remember registry and encoding of the frame font. */
5644 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5645 if (STRINGP (unibyte_registry
))
5646 Vface_default_registry
= unibyte_registry
;
5648 Vface_default_registry
= build_string ("iso8859-1");
5650 /* But set the family to the fontset alias name. Implementation
5651 note: When a font is passed to Emacs via `-fn FONT', a
5652 fontset is created in `x-win.el' whose name ends in
5653 `fontset-startup'. This fontset has an alias name that is
5654 equal to frame_font. */
5655 xassert (STRINGP (frame_font
));
5656 font
.name
= LSTRDUPA (frame_font
);
5658 if (!split_font_name (f
, &font
, 1)
5659 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5660 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5661 LFACE_FAMILY (lface
) = frame_font
;
5665 /* Frame parameters contain a real font. Fill default face
5666 attributes from that font. */
5667 if (!set_lface_from_font_name (f
, lface
,
5668 XSTRING (frame_font
)->data
, 0, 0))
5671 /* Remember registry and encoding of the frame font. */
5673 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5674 if (STRINGP (unibyte_registry
))
5675 Vface_default_registry
= unibyte_registry
;
5677 Vface_default_registry
= build_string ("iso8859-1");
5680 #endif /* HAVE_X_WINDOWS */
5682 if (!FRAME_WINDOW_P (f
))
5684 LFACE_FAMILY (lface
) = build_string ("default");
5685 LFACE_SWIDTH (lface
) = Qnormal
;
5686 LFACE_HEIGHT (lface
) = make_number (1);
5687 LFACE_WEIGHT (lface
) = Qnormal
;
5688 LFACE_SLANT (lface
) = Qnormal
;
5691 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5692 LFACE_UNDERLINE (lface
) = Qnil
;
5694 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5695 LFACE_OVERLINE (lface
) = Qnil
;
5697 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5698 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5700 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5701 LFACE_BOX (lface
) = Qnil
;
5703 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5704 LFACE_INVERSE (lface
) = Qnil
;
5706 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5708 /* This function is called so early that colors are not yet
5709 set in the frame parameter list. */
5710 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5712 if (CONSP (color
) && STRINGP (XCDR (color
)))
5713 LFACE_FOREGROUND (lface
) = XCDR (color
);
5714 else if (FRAME_X_P (f
))
5716 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5717 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5722 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5724 /* This function is called so early that colors are not yet
5725 set in the frame parameter list. */
5726 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5727 if (CONSP (color
) && STRINGP (XCDR (color
)))
5728 LFACE_BACKGROUND (lface
) = XCDR (color
);
5729 else if (FRAME_X_P (f
))
5731 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5732 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5737 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5738 LFACE_STIPPLE (lface
) = Qnil
;
5740 /* Realize the face; it must be fully-specified now. */
5741 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5742 check_lface (lface
);
5743 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5744 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5746 /* Remove the former default face. */
5747 if (c
->used
> DEFAULT_FACE_ID
)
5749 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5750 uncache_face (c
, default_face
);
5751 free_realized_face (f
, default_face
);
5754 /* Insert the new default face. */
5755 cache_face (c
, face
, lface_hash (attrs
));
5756 xassert (face
->id
== DEFAULT_FACE_ID
);
5761 /* Realize basic faces other than the default face in face cache C.
5762 SYMBOL is the face name, ID is the face id the realized face must
5763 have. The default face must have been realized already. */
5766 realize_named_face (f
, symbol
, id
)
5771 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5772 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5773 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5774 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5775 struct face
*new_face
;
5777 /* The default face must exist and be fully specified. */
5778 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5779 check_lface_attrs (attrs
);
5780 xassert (lface_fully_specified_p (attrs
));
5782 /* If SYMBOL isn't know as a face, create it. */
5786 XSETFRAME (frame
, f
);
5787 lface
= Finternal_make_lisp_face (symbol
, frame
);
5790 /* Merge SYMBOL's face with the default face. */
5791 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5792 merge_face_vectors (symbol_attrs
, attrs
);
5794 /* Realize the face. */
5795 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5797 /* Remove the former face. */
5800 struct face
*old_face
= c
->faces_by_id
[id
];
5801 uncache_face (c
, old_face
);
5802 free_realized_face (f
, old_face
);
5805 /* Insert the new face. */
5806 cache_face (c
, new_face
, lface_hash (attrs
));
5807 xassert (new_face
->id
== id
);
5811 /* Realize the fully-specified face with attributes ATTRS in face
5812 cache C for character set CHARSET or for unibyte text if CHARSET <
5813 0. Value is a pointer to the newly created realized face. */
5815 static struct face
*
5816 realize_face (c
, attrs
, charset
)
5817 struct face_cache
*c
;
5823 /* LFACE must be fully specified. */
5824 xassert (c
!= NULL
);
5825 check_lface_attrs (attrs
);
5827 if (FRAME_X_P (c
->f
))
5828 face
= realize_x_face (c
, attrs
, charset
);
5829 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5830 face
= realize_tty_face (c
, attrs
, charset
);
5838 /* Realize the fully-specified face with attributes ATTRS in face
5839 cache C for character set CHARSET or for unibyte text if CHARSET <
5840 0. Do it for X frame C->f. Value is a pointer to the newly
5841 created realized face. */
5843 static struct face
*
5844 realize_x_face (c
, attrs
, charset
)
5845 struct face_cache
*c
;
5849 #ifdef HAVE_X_WINDOWS
5850 struct face
*face
, *default_face
;
5852 Lisp_Object stipple
, overline
, strike_through
, box
;
5853 Lisp_Object unibyte_registry
;
5854 struct gcpro gcpro1
;
5856 xassert (FRAME_X_P (c
->f
));
5858 /* If realizing a face for use in unibyte text, get the X registry
5859 and encoding to use from Vface_default_registry. */
5861 unibyte_registry
= (STRINGP (Vface_default_registry
)
5862 ? Vface_default_registry
5863 : build_string ("iso8859-1"));
5865 unibyte_registry
= Qnil
;
5866 GCPRO1 (unibyte_registry
);
5868 /* Allocate a new realized face. */
5869 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5872 /* Determine the font to use. Most of the time, the font will be
5873 the same as the font of the default face, so try that first. */
5874 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5876 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5877 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5879 face
->font
= default_face
->font
;
5880 face
->fontset
= default_face
->fontset
;
5881 face
->font_info_id
= default_face
->font_info_id
;
5882 face
->font_name
= default_face
->font_name
;
5883 face
->registry
= default_face
->registry
;
5885 else if (charset
>= 0)
5887 /* For all charsets, we use our own font selection functions to
5888 choose a best matching font for the specified face
5889 attributes. If the face specifies a fontset alias name, the
5890 fontset determines the font name pattern, otherwise we
5891 construct a font pattern from face attributes and charset. */
5893 char *font_name
= NULL
;
5894 int fontset
= face_fontset (f
, attrs
);
5897 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5900 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5904 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5909 /* Unibyte case, and font is not equal to that of the default
5910 face. UNIBYTE_REGISTRY is the X registry and encoding the
5911 font should have. What is a reasonable thing to do if the
5912 user specified a fontset alias name for the face in this
5913 case? We choose a font by taking the ASCII font of the
5914 fontset, but using UNIBYTE_REGISTRY for its registry and
5917 char *font_name
= NULL
;
5918 int fontset
= face_fontset (f
, attrs
);
5921 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5923 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5925 load_face_font_or_fontset (f
, face
, font_name
, -1);
5929 /* Load colors, and set remaining attributes. */
5931 load_face_colors (f
, face
, attrs
);
5934 box
= attrs
[LFACE_BOX_INDEX
];
5937 /* A simple box of line width 1 drawn in color given by
5939 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5941 face
->box
= FACE_SIMPLE_BOX
;
5942 face
->box_line_width
= 1;
5944 else if (INTEGERP (box
))
5946 /* Simple box of specified line width in foreground color of the
5948 xassert (XINT (box
) > 0);
5949 face
->box
= FACE_SIMPLE_BOX
;
5950 face
->box_line_width
= XFASTINT (box
);
5951 face
->box_color
= face
->foreground
;
5952 face
->box_color_defaulted_p
= 1;
5954 else if (CONSP (box
))
5956 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5957 being one of `raised' or `sunken'. */
5958 face
->box
= FACE_SIMPLE_BOX
;
5959 face
->box_color
= face
->foreground
;
5960 face
->box_color_defaulted_p
= 1;
5961 face
->box_line_width
= 1;
5965 Lisp_Object keyword
, value
;
5967 keyword
= XCAR (box
);
5975 if (EQ (keyword
, QCline_width
))
5977 if (INTEGERP (value
) && XINT (value
) > 0)
5978 face
->box_line_width
= XFASTINT (value
);
5980 else if (EQ (keyword
, QCcolor
))
5982 if (STRINGP (value
))
5984 face
->box_color
= load_color (f
, face
, value
,
5986 face
->use_box_color_for_shadows_p
= 1;
5989 else if (EQ (keyword
, QCstyle
))
5991 if (EQ (value
, Qreleased_button
))
5992 face
->box
= FACE_RAISED_BOX
;
5993 else if (EQ (value
, Qpressed_button
))
5994 face
->box
= FACE_SUNKEN_BOX
;
5999 /* Text underline, overline, strike-through. */
6001 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6003 /* Use default color (same as foreground color). */
6004 face
->underline_p
= 1;
6005 face
->underline_defaulted_p
= 1;
6006 face
->underline_color
= 0;
6008 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6010 /* Use specified color. */
6011 face
->underline_p
= 1;
6012 face
->underline_defaulted_p
= 0;
6013 face
->underline_color
6014 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6015 LFACE_UNDERLINE_INDEX
);
6017 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6019 face
->underline_p
= 0;
6020 face
->underline_defaulted_p
= 0;
6021 face
->underline_color
= 0;
6024 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6025 if (STRINGP (overline
))
6027 face
->overline_color
6028 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6029 LFACE_OVERLINE_INDEX
);
6030 face
->overline_p
= 1;
6032 else if (EQ (overline
, Qt
))
6034 face
->overline_color
= face
->foreground
;
6035 face
->overline_color_defaulted_p
= 1;
6036 face
->overline_p
= 1;
6039 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6040 if (STRINGP (strike_through
))
6042 face
->strike_through_color
6043 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6044 LFACE_STRIKE_THROUGH_INDEX
);
6045 face
->strike_through_p
= 1;
6047 else if (EQ (strike_through
, Qt
))
6049 face
->strike_through_color
= face
->foreground
;
6050 face
->strike_through_color_defaulted_p
= 1;
6051 face
->strike_through_p
= 1;
6054 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6055 if (!NILP (stipple
))
6056 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6059 xassert (face
->fontset
< 0);
6060 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6062 #endif /* HAVE_X_WINDOWS */
6066 /* Realize the fully-specified face with attributes ATTRS in face
6067 cache C for character set CHARSET or for unibyte text if CHARSET <
6068 0. Do it for TTY frame C->f. Value is a pointer to the newly
6069 created realized face. */
6071 static struct face
*
6072 realize_tty_face (c
, attrs
, charset
)
6073 struct face_cache
*c
;
6080 Lisp_Object tty_defined_color_alist
=
6081 Fsymbol_value (intern ("tty-defined-color-alist"));
6082 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6084 int face_colors_defaulted
= 0;
6086 /* Frame must be a termcap frame. */
6087 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6089 /* Allocate a new realized face. */
6090 face
= make_realized_face (attrs
, charset
, Qnil
);
6091 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6093 /* Map face attributes to TTY appearances. We map slant to
6094 dimmed text because we want italic text to appear differently
6095 and because dimmed text is probably used infrequently. */
6096 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6097 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6099 if (weight
> XLFD_WEIGHT_MEDIUM
)
6100 face
->tty_bold_p
= 1;
6101 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6102 face
->tty_dim_p
= 1;
6103 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6104 face
->tty_underline_p
= 1;
6105 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6106 face
->tty_reverse_p
= 1;
6108 /* Map color names to color indices. */
6109 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6110 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6112 XSETFRAME (frame
, c
->f
);
6113 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6115 && XSTRING (color
)->size
6116 && !NILP (tty_defined_color_alist
)
6117 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6119 /* Associations in tty-defined-color-alist are of the form
6120 (NAME INDEX R G B). We need the INDEX part. */
6121 face
->foreground
= XINT (XCAR (XCDR (color
)));
6123 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6124 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6126 face
->foreground
= load_color (c
->f
, face
,
6127 attrs
[LFACE_FOREGROUND_INDEX
],
6128 LFACE_FOREGROUND_INDEX
);
6130 /* If the foreground of the default face is the default color,
6131 use the foreground color defined by the frame. */
6132 if (FRAME_MSDOS_P (c
->f
))
6134 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6135 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6137 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6138 attrs
[LFACE_FOREGROUND_INDEX
] =
6139 msdos_stdcolor_name (face
->foreground
);
6140 face_colors_defaulted
= 1;
6142 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6144 face
->foreground
= FRAME_BACKGROUND_PIXEL (f
);
6145 attrs
[LFACE_FOREGROUND_INDEX
] =
6146 msdos_stdcolor_name (face
->foreground
);
6147 face_colors_defaulted
= 1;
6153 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6155 && XSTRING (color
)->size
6156 && !NILP (tty_defined_color_alist
)
6157 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6159 /* Associations in tty-defined-color-alist are of the form
6160 (NAME INDEX R G B). We need the INDEX part. */
6161 face
->background
= XINT (XCAR (XCDR (color
)));
6163 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6164 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6166 face
->background
= load_color (c
->f
, face
,
6167 attrs
[LFACE_BACKGROUND_INDEX
],
6168 LFACE_BACKGROUND_INDEX
);
6170 /* If the background of the default face is the default color,
6171 use the background color defined by the frame. */
6172 if (FRAME_MSDOS_P (c
->f
))
6174 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6175 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6177 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6178 attrs
[LFACE_BACKGROUND_INDEX
] =
6179 msdos_stdcolor_name (face
->background
);
6180 face_colors_defaulted
= 1;
6182 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6184 face
->background
= FRAME_FOREGROUND_PIXEL (f
);
6185 attrs
[LFACE_BACKGROUND_INDEX
] =
6186 msdos_stdcolor_name (face
->background
);
6187 face_colors_defaulted
= 1;
6193 /* Swap colors if face is inverse-video. If the colors are taken
6194 from the frame colors, they are already inverted, since the
6195 frame-creation function calls x-handle-reverse-video. */
6196 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6198 unsigned long tem
= face
->foreground
;
6200 face
->foreground
= face
->background
;
6201 face
->background
= tem
;
6209 /***********************************************************************
6211 ***********************************************************************/
6213 /* Return the ID of the face to use to display character CH with face
6214 property PROP on frame F in current_buffer. */
6217 compute_char_face (f
, ch
, prop
)
6223 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6225 : CHAR_CHARSET (ch
));
6228 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6231 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6232 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6233 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6234 merge_face_vector_with_property (f
, attrs
, prop
);
6235 face_id
= lookup_face (f
, attrs
, charset
);
6242 /* Return the face ID associated with buffer position POS for
6243 displaying ASCII characters. Return in *ENDPTR the position at
6244 which a different face is needed, as far as text properties and
6245 overlays are concerned. W is a window displaying current_buffer.
6247 REGION_BEG, REGION_END delimit the region, so it can be
6250 LIMIT is a position not to scan beyond. That is to limit the time
6251 this function can take.
6253 If MOUSE is non-zero, use the character's mouse-face, not its face.
6255 The face returned is suitable for displaying CHARSET_ASCII if
6256 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6257 the face is suitable for displaying unibyte text. */
6260 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6261 endptr
, limit
, mouse
)
6264 int region_beg
, region_end
;
6269 struct frame
*f
= XFRAME (w
->frame
);
6270 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6271 Lisp_Object prop
, position
;
6273 Lisp_Object
*overlay_vec
;
6276 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6277 Lisp_Object limit1
, end
;
6278 struct face
*default_face
;
6279 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6281 /* W must display the current buffer. We could write this function
6282 to use the frame and buffer of W, but right now it doesn't. */
6283 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6285 XSETFRAME (frame
, f
);
6286 XSETFASTINT (position
, pos
);
6289 if (pos
< region_beg
&& region_beg
< endpos
)
6290 endpos
= region_beg
;
6292 /* Get the `face' or `mouse_face' text property at POS, and
6293 determine the next position at which the property changes. */
6294 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6295 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6296 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6298 endpos
= XINT (end
);
6300 /* Look at properties from overlays. */
6305 /* First try with room for 40 overlays. */
6307 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6308 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6309 &next_overlay
, NULL
);
6311 /* If there are more than 40, make enough space for all, and try
6313 if (noverlays
> len
)
6316 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6317 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6318 &next_overlay
, NULL
);
6321 if (next_overlay
< endpos
)
6322 endpos
= next_overlay
;
6327 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6329 /* Optimize common cases where we can use the default face. */
6332 && !(pos
>= region_beg
&& pos
< region_end
)
6334 || !FRAME_WINDOW_P (f
)
6335 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6336 return DEFAULT_FACE_ID
;
6338 /* Begin with attributes from the default face. */
6339 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6341 /* Merge in attributes specified via text properties. */
6343 merge_face_vector_with_property (f
, attrs
, prop
);
6345 /* Now merge the overlay data. */
6346 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6347 for (i
= 0; i
< noverlays
; i
++)
6352 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6354 merge_face_vector_with_property (f
, attrs
, prop
);
6356 oend
= OVERLAY_END (overlay_vec
[i
]);
6357 oendpos
= OVERLAY_POSITION (oend
);
6358 if (oendpos
< endpos
)
6362 /* If in the region, merge in the region face. */
6363 if (pos
>= region_beg
&& pos
< region_end
)
6365 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6366 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6368 if (region_end
< endpos
)
6369 endpos
= region_end
;
6374 /* Look up a realized face with the given face attributes,
6375 or realize a new one. Charset is ignored for tty frames. */
6376 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6380 /* Compute the face at character position POS in Lisp string STRING on
6381 window W, for charset CHARSET_ASCII.
6383 If STRING is an overlay string, it comes from position BUFPOS in
6384 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6385 not an overlay string. W must display the current buffer.
6386 REGION_BEG and REGION_END give the start and end positions of the
6387 region; both are -1 if no region is visible. BASE_FACE_ID is the
6388 id of the basic face to merge with. It is usually equal to
6389 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6390 for strings displayed in the mode or top line.
6392 Set *ENDPTR to the next position where to check for faces in
6393 STRING; -1 if the face is constant from POS to the end of the
6396 Value is the id of the face to use. The face returned is suitable
6397 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6398 the face is suitable for displaying unibyte text. */
6401 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6402 region_end
, endptr
, base_face_id
)
6406 int region_beg
, region_end
;
6408 enum face_id base_face_id
;
6410 Lisp_Object prop
, position
, end
, limit
;
6411 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6412 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6413 struct face
*base_face
;
6414 int multibyte_p
= STRING_MULTIBYTE (string
);
6416 /* Get the value of the face property at the current position within
6417 STRING. Value is nil if there is no face property. */
6418 XSETFASTINT (position
, pos
);
6419 prop
= Fget_text_property (position
, Qface
, string
);
6421 /* Get the next position at which to check for faces. Value of end
6422 is nil if face is constant all the way to the end of the string.
6423 Otherwise it is a string position where to check faces next.
6424 Limit is the maximum position up to which to check for property
6425 changes in Fnext_single_property_change. Strings are usually
6426 short, so set the limit to the end of the string. */
6427 XSETFASTINT (limit
, XSTRING (string
)->size
);
6428 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6430 *endptr
= XFASTINT (end
);
6434 base_face
= FACE_FROM_ID (f
, base_face_id
);
6435 xassert (base_face
);
6437 /* Optimize the default case that there is no face property and we
6438 are not in the region. */
6440 && (base_face_id
!= DEFAULT_FACE_ID
6441 /* BUFPOS <= 0 means STRING is not an overlay string, so
6442 that the region doesn't have to be taken into account. */
6444 || bufpos
< region_beg
6445 || bufpos
>= region_end
)
6447 /* We can't realize faces for different charsets differently
6448 if we don't have fonts, so we can stop here if not working
6449 on a window-system frame. */
6450 || !FRAME_WINDOW_P (f
)
6451 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6452 return base_face
->id
;
6454 /* Begin with attributes from the base face. */
6455 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6457 /* Merge in attributes specified via text properties. */
6459 merge_face_vector_with_property (f
, attrs
, prop
);
6461 /* If in the region, merge in the region face. */
6463 && bufpos
>= region_beg
6464 && bufpos
< region_end
)
6466 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6467 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6470 /* Look up a realized face with the given face attributes,
6471 or realize a new one. */
6472 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6477 /***********************************************************************
6479 ***********************************************************************/
6483 /* Print the contents of the realized face FACE to stderr. */
6486 dump_realized_face (face
)
6489 fprintf (stderr
, "ID: %d\n", face
->id
);
6490 #ifdef HAVE_X_WINDOWS
6491 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6493 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6495 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6496 fprintf (stderr
, "background: 0x%lx (%s)\n",
6498 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6499 fprintf (stderr
, "font_name: %s (%s)\n",
6501 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6502 #ifdef HAVE_X_WINDOWS
6503 fprintf (stderr
, "font = %p\n", face
->font
);
6505 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6506 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6507 fprintf (stderr
, "underline: %d (%s)\n",
6509 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6510 fprintf (stderr
, "hash: %d\n", face
->hash
);
6511 fprintf (stderr
, "charset: %d\n", face
->charset
);
6515 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6523 fprintf (stderr
, "font selection order: ");
6524 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6525 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6526 fprintf (stderr
, "\n");
6528 fprintf (stderr
, "alternative fonts: ");
6529 debug_print (Vface_alternative_font_family_alist
);
6530 fprintf (stderr
, "\n");
6532 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6533 Fdump_face (make_number (i
));
6538 CHECK_NUMBER (n
, 0);
6539 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6541 error ("Not a valid face");
6542 dump_realized_face (face
);
6549 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6553 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6554 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6555 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6559 #endif /* GLYPH_DEBUG != 0 */
6563 /***********************************************************************
6565 ***********************************************************************/
6570 Qface
= intern ("face");
6572 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6573 staticpro (&Qbitmap_spec_p
);
6574 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6575 staticpro (&Qframe_update_face_colors
);
6577 /* Lisp face attribute keywords. */
6578 QCfamily
= intern (":family");
6579 staticpro (&QCfamily
);
6580 QCheight
= intern (":height");
6581 staticpro (&QCheight
);
6582 QCweight
= intern (":weight");
6583 staticpro (&QCweight
);
6584 QCslant
= intern (":slant");
6585 staticpro (&QCslant
);
6586 QCunderline
= intern (":underline");
6587 staticpro (&QCunderline
);
6588 QCinverse_video
= intern (":inverse-video");
6589 staticpro (&QCinverse_video
);
6590 QCreverse_video
= intern (":reverse-video");
6591 staticpro (&QCreverse_video
);
6592 QCforeground
= intern (":foreground");
6593 staticpro (&QCforeground
);
6594 QCbackground
= intern (":background");
6595 staticpro (&QCbackground
);
6596 QCstipple
= intern (":stipple");;
6597 staticpro (&QCstipple
);
6598 QCwidth
= intern (":width");
6599 staticpro (&QCwidth
);
6600 QCfont
= intern (":font");
6601 staticpro (&QCfont
);
6602 QCbold
= intern (":bold");
6603 staticpro (&QCbold
);
6604 QCitalic
= intern (":italic");
6605 staticpro (&QCitalic
);
6606 QCoverline
= intern (":overline");
6607 staticpro (&QCoverline
);
6608 QCstrike_through
= intern (":strike-through");
6609 staticpro (&QCstrike_through
);
6610 QCbox
= intern (":box");
6613 /* Symbols used for Lisp face attribute values. */
6614 QCcolor
= intern (":color");
6615 staticpro (&QCcolor
);
6616 QCline_width
= intern (":line-width");
6617 staticpro (&QCline_width
);
6618 QCstyle
= intern (":style");
6619 staticpro (&QCstyle
);
6620 Qreleased_button
= intern ("released-button");
6621 staticpro (&Qreleased_button
);
6622 Qpressed_button
= intern ("pressed-button");
6623 staticpro (&Qpressed_button
);
6624 Qnormal
= intern ("normal");
6625 staticpro (&Qnormal
);
6626 Qultra_light
= intern ("ultra-light");
6627 staticpro (&Qultra_light
);
6628 Qextra_light
= intern ("extra-light");
6629 staticpro (&Qextra_light
);
6630 Qlight
= intern ("light");
6631 staticpro (&Qlight
);
6632 Qsemi_light
= intern ("semi-light");
6633 staticpro (&Qsemi_light
);
6634 Qsemi_bold
= intern ("semi-bold");
6635 staticpro (&Qsemi_bold
);
6636 Qbold
= intern ("bold");
6638 Qextra_bold
= intern ("extra-bold");
6639 staticpro (&Qextra_bold
);
6640 Qultra_bold
= intern ("ultra-bold");
6641 staticpro (&Qultra_bold
);
6642 Qoblique
= intern ("oblique");
6643 staticpro (&Qoblique
);
6644 Qitalic
= intern ("italic");
6645 staticpro (&Qitalic
);
6646 Qreverse_oblique
= intern ("reverse-oblique");
6647 staticpro (&Qreverse_oblique
);
6648 Qreverse_italic
= intern ("reverse-italic");
6649 staticpro (&Qreverse_italic
);
6650 Qultra_condensed
= intern ("ultra-condensed");
6651 staticpro (&Qultra_condensed
);
6652 Qextra_condensed
= intern ("extra-condensed");
6653 staticpro (&Qextra_condensed
);
6654 Qcondensed
= intern ("condensed");
6655 staticpro (&Qcondensed
);
6656 Qsemi_condensed
= intern ("semi-condensed");
6657 staticpro (&Qsemi_condensed
);
6658 Qsemi_expanded
= intern ("semi-expanded");
6659 staticpro (&Qsemi_expanded
);
6660 Qexpanded
= intern ("expanded");
6661 staticpro (&Qexpanded
);
6662 Qextra_expanded
= intern ("extra-expanded");
6663 staticpro (&Qextra_expanded
);
6664 Qultra_expanded
= intern ("ultra-expanded");
6665 staticpro (&Qultra_expanded
);
6666 Qbackground_color
= intern ("background-color");
6667 staticpro (&Qbackground_color
);
6668 Qforeground_color
= intern ("foreground-color");
6669 staticpro (&Qforeground_color
);
6670 Qunspecified
= intern ("unspecified");
6671 staticpro (&Qunspecified
);
6673 Qx_charset_registry
= intern ("x-charset-registry");
6674 staticpro (&Qx_charset_registry
);
6675 Qface_alias
= intern ("face-alias");
6676 staticpro (&Qface_alias
);
6677 Qdefault
= intern ("default");
6678 staticpro (&Qdefault
);
6679 Qtool_bar
= intern ("tool-bar");
6680 staticpro (&Qtool_bar
);
6681 Qregion
= intern ("region");
6682 staticpro (&Qregion
);
6683 Qfringe
= intern ("fringe");
6684 staticpro (&Qfringe
);
6685 Qheader_line
= intern ("header-line");
6686 staticpro (&Qheader_line
);
6687 Qscroll_bar
= intern ("scroll-bar");
6688 staticpro (&Qscroll_bar
);
6689 Qmenu
= intern ("menu");
6691 Qcursor
= intern ("cursor");
6692 staticpro (&Qcursor
);
6693 Qborder
= intern ("border");
6694 staticpro (&Qborder
);
6695 Qmouse
= intern ("mouse");
6696 staticpro (&Qmouse
);
6697 Qtty_color_desc
= intern ("tty-color-desc");
6698 staticpro (&Qtty_color_desc
);
6699 Qtty_color_by_index
= intern ("tty-color-by-index");
6700 staticpro (&Qtty_color_by_index
);
6702 defsubr (&Sinternal_make_lisp_face
);
6703 defsubr (&Sinternal_lisp_face_p
);
6704 defsubr (&Sinternal_set_lisp_face_attribute
);
6705 #ifdef HAVE_X_WINDOWS
6706 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6708 defsubr (&Scolor_gray_p
);
6709 defsubr (&Scolor_supported_p
);
6710 defsubr (&Sinternal_get_lisp_face_attribute
);
6711 defsubr (&Sinternal_lisp_face_attribute_values
);
6712 defsubr (&Sinternal_lisp_face_equal_p
);
6713 defsubr (&Sinternal_lisp_face_empty_p
);
6714 defsubr (&Sinternal_copy_lisp_face
);
6715 defsubr (&Sinternal_merge_in_global_face
);
6716 defsubr (&Sface_font
);
6717 defsubr (&Sframe_face_alist
);
6718 defsubr (&Sinternal_set_font_selection_order
);
6719 defsubr (&Sinternal_set_alternative_font_family_alist
);
6721 defsubr (&Sdump_face
);
6722 defsubr (&Sshow_face_resources
);
6723 #endif /* GLYPH_DEBUG */
6724 defsubr (&Sclear_face_cache
);
6726 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6727 "*Limit for font matching.\n\
6728 If an integer > 0, font matching functions won't load more than\n\
6729 that number of fonts when searching for a matching font.");
6730 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6732 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6733 "List of global face definitions (for internal use only.)");
6734 Vface_new_frame_defaults
= Qnil
;
6736 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6737 "*Default stipple pattern used on monochrome displays.\n\
6738 This stipple pattern is used on monochrome displays\n\
6739 instead of shades of gray for a face background color.\n\
6740 See `set-face-stipple' for possible values for this variable.");
6741 Vface_default_stipple
= build_string ("gray3");
6743 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6744 "Default registry and encoding to use.\n\
6745 This registry and encoding is used for unibyte text. It is set up\n\
6746 from the specified frame font when Emacs starts. (For internal use only.)");
6747 Vface_default_registry
= Qnil
;
6749 DEFVAR_LISP ("face-alternative-font-family-alist",
6750 &Vface_alternative_font_family_alist
, "");
6751 Vface_alternative_font_family_alist
= Qnil
;
6755 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6756 "Allowed scalable fonts.\n\
6757 A value of nil means don't allow any scalable fonts.\n\
6758 A value of t means allow any scalable font.\n\
6759 Otherwise, value must be a list of regular expressions. A font may be\n\
6760 scaled if its name matches a regular expression in the list.");
6761 Vscalable_fonts_allowed
= Qnil
;
6763 #endif /* SCALABLE_FONTS */
6765 #ifdef HAVE_X_WINDOWS
6766 defsubr (&Sbitmap_spec_p
);
6767 defsubr (&Sx_list_fonts
);
6768 defsubr (&Sinternal_face_x_get_resource
);
6769 defsubr (&Sx_family_fonts
);
6770 defsubr (&Sx_font_family_list
);
6771 #endif /* HAVE_X_WINDOWS */