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
, Qunspecified_fg
, Qunspecified_bg
;
287 /* The symbol `x-charset-registry'. This property of charsets defines
288 the X registry and encoding that fonts should have that are used to
289 display characters of that charset. */
291 Lisp_Object Qx_charset_registry
;
293 /* The name of the function to call when the background of the frame
294 has changed, frame_update_face_colors. */
296 Lisp_Object Qframe_update_face_colors
;
298 /* Names of basic faces. */
300 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
301 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
302 extern Lisp_Object Qmode_line
;
304 /* The symbol `face-alias'. A symbols having that property is an
305 alias for another face. Value of the property is the name of
308 Lisp_Object Qface_alias
;
310 /* Names of frame parameters related to faces. */
312 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
313 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
315 /* Default stipple pattern used on monochrome displays. This stipple
316 pattern is used on monochrome displays instead of shades of gray
317 for a face background color. See `set-face-stipple' for possible
318 values for this variable. */
320 Lisp_Object Vface_default_stipple
;
322 /* Default registry and encoding to use for charsets whose charset
323 symbols don't specify one. */
325 Lisp_Object Vface_default_registry
;
327 /* Alist of alternative font families. Each element is of the form
328 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
329 try FAMILY1, then FAMILY2, ... */
331 Lisp_Object Vface_alternative_font_family_alist
;
333 /* Allowed scalable fonts. A value of nil means don't allow any
334 scalable fonts. A value of t means allow the use of any scalable
335 font. Otherwise, value must be a list of regular expressions. A
336 font may be scaled if its name matches a regular expression in the
340 Lisp_Object Vscalable_fonts_allowed
;
343 /* Maximum number of fonts to consider in font_list. If not an
344 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
346 Lisp_Object Vfont_list_limit
;
347 #define DEFAULT_FONT_LIST_LIMIT 100
349 /* The symbols `foreground-color' and `background-color' which can be
350 used as part of a `face' property. This is for compatibility with
353 Lisp_Object Qforeground_color
, Qbackground_color
;
355 /* The symbols `face' and `mouse-face' used as text properties. */
358 extern Lisp_Object Qmouse_face
;
360 /* Error symbol for wrong_type_argument in load_pixmap. */
362 Lisp_Object Qbitmap_spec_p
;
364 /* Alist of global face definitions. Each element is of the form
365 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
366 is a Lisp vector of face attributes. These faces are used
367 to initialize faces for new frames. */
369 Lisp_Object Vface_new_frame_defaults
;
371 /* The next ID to assign to Lisp faces. */
373 static int next_lface_id
;
375 /* A vector mapping Lisp face Id's to face names. */
377 static Lisp_Object
*lface_id_to_name
;
378 static int lface_id_to_name_size
;
380 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
381 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
383 /* Counter for calls to clear_face_cache. If this counter reaches
384 CLEAR_FONT_TABLE_COUNT, and a frame has more than
385 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
387 static int clear_font_table_count
;
388 #define CLEAR_FONT_TABLE_COUNT 100
389 #define CLEAR_FONT_TABLE_NFONTS 10
391 /* Non-zero means face attributes have been changed since the last
392 redisplay. Used in redisplay_internal. */
394 int face_change_count
;
396 /* The total number of colors currently allocated. */
399 static int ncolors_allocated
;
400 static int npixmaps_allocated
;
406 /* Function prototypes. */
411 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
412 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
413 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
414 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
416 static int first_font_matching
P_ ((struct frame
*f
, char *,
417 struct font_name
*));
418 static int x_face_list_fonts
P_ ((struct frame
*, char *,
419 struct font_name
*, int, int, int));
420 static int font_scalable_p
P_ ((struct font_name
*));
421 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
422 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
423 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
424 static char *xstrdup
P_ ((char *));
425 static unsigned char *xstrlwr
P_ ((unsigned char *));
426 static void signal_error
P_ ((char *, Lisp_Object
));
427 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
428 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
429 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
430 static void free_face_colors
P_ ((struct frame
*, struct face
*));
431 static int face_color_gray_p
P_ ((struct frame
*, char *));
432 static char *build_font_name
P_ ((struct font_name
*));
433 static void free_font_names
P_ ((struct font_name
*, int));
434 static int sorted_font_list
P_ ((struct frame
*, char *,
435 int (*cmpfn
) P_ ((const void *, const void *)),
436 struct font_name
**));
437 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
438 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
439 struct font_name
**));
440 static int cmp_font_names
P_ ((const void *, const void *));
441 static struct face
*realize_face
P_ ((struct face_cache
*,
442 Lisp_Object
*, int));
443 static struct face
*realize_x_face
P_ ((struct face_cache
*,
444 Lisp_Object
*, int));
445 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
446 Lisp_Object
*, int));
447 static int realize_basic_faces
P_ ((struct frame
*));
448 static int realize_default_face
P_ ((struct frame
*));
449 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
450 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
451 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
452 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
453 static unsigned lface_hash
P_ ((Lisp_Object
*));
454 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
455 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
456 static void free_realized_face
P_ ((struct frame
*, struct face
*));
457 static void clear_face_gcs
P_ ((struct face_cache
*));
458 static void free_face_cache
P_ ((struct face_cache
*));
459 static int face_numeric_weight
P_ ((Lisp_Object
));
460 static int face_numeric_slant
P_ ((Lisp_Object
));
461 static int face_numeric_swidth
P_ ((Lisp_Object
));
462 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
463 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
465 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
467 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
468 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
470 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
472 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
473 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
474 static void free_realized_faces
P_ ((struct face_cache
*));
475 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
476 struct font_name
*, int));
477 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
478 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
479 static int xlfd_numeric_slant
P_ ((struct font_name
*));
480 static int xlfd_numeric_weight
P_ ((struct font_name
*));
481 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
482 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
483 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
484 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
485 static int xlfd_fixed_p
P_ ((struct font_name
*));
486 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
488 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
489 struct font_name
*, int, int));
490 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
491 struct font_name
*, int));
493 #ifdef HAVE_X_WINDOWS
495 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
496 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
497 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
498 int (*cmpfn
) P_ ((const void *, const void *))));
499 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
500 static void x_free_gc
P_ ((struct frame
*, GC
));
501 static void clear_font_table
P_ ((struct frame
*));
503 #endif /* HAVE_X_WINDOWS */
506 /***********************************************************************
508 ***********************************************************************/
510 #ifdef HAVE_X_WINDOWS
512 /* Create and return a GC for use on frame F. GC values and mask
513 are given by XGCV and MASK. */
516 x_create_gc (f
, mask
, xgcv
)
523 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
530 /* Free GC which was used on frame F. */
538 xassert (--ngcs
>= 0);
539 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
543 #endif /* HAVE_X_WINDOWS */
546 /* Like strdup, but uses xmalloc. */
552 int len
= strlen (s
) + 1;
553 char *p
= (char *) xmalloc (len
);
559 /* Like stricmp. Used to compare parts of font names which are in
564 unsigned char *s1
, *s2
;
568 unsigned char c1
= tolower (*s1
);
569 unsigned char c2
= tolower (*s2
);
571 return c1
< c2
? -1 : 1;
576 return *s2
== 0 ? 0 : -1;
581 /* Like strlwr, which might not always be available. */
583 static unsigned char *
587 unsigned char *p
= s
;
596 /* Signal `error' with message S, and additional argument ARG. */
599 signal_error (s
, arg
)
603 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
607 /* If FRAME is nil, return a pointer to the selected frame.
608 Otherwise, check that FRAME is a live frame, and return a pointer
609 to it. NPARAM is the parameter number of FRAME, for
610 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
611 Lisp function definitions. */
613 static INLINE
struct frame
*
614 frame_or_selected_frame (frame
, nparam
)
619 frame
= selected_frame
;
621 CHECK_LIVE_FRAME (frame
, nparam
);
622 return XFRAME (frame
);
626 /***********************************************************************
628 ***********************************************************************/
630 /* Initialize face cache and basic faces for frame F. */
636 /* Make a face cache, if F doesn't have one. */
637 if (FRAME_FACE_CACHE (f
) == NULL
)
638 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
640 #ifdef HAVE_X_WINDOWS
641 /* Make the image cache. */
644 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
645 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
646 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
648 #endif /* HAVE_X_WINDOWS */
650 /* Realize basic faces. Must have enough information in frame
651 parameters to realize basic faces at this point. */
652 #ifdef HAVE_X_WINDOWS
653 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
655 if (!realize_basic_faces (f
))
660 /* Free face cache of frame F. Called from Fdelete_frame. */
666 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
670 free_face_cache (face_cache
);
671 FRAME_FACE_CACHE (f
) = NULL
;
674 #ifdef HAVE_X_WINDOWS
677 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
680 --image_cache
->refcount
;
681 if (image_cache
->refcount
== 0)
682 free_image_cache (f
);
685 #endif /* HAVE_X_WINDOWS */
689 /* Clear face caches, and recompute basic faces for frame F. Call
690 this after changing frame parameters on which those faces depend,
691 or when realized faces have been freed due to changing attributes
695 recompute_basic_faces (f
)
698 if (FRAME_FACE_CACHE (f
))
700 clear_face_cache (0);
701 if (!realize_basic_faces (f
))
707 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
708 try to free unused fonts, too. */
711 clear_face_cache (clear_fonts_p
)
714 #ifdef HAVE_X_WINDOWS
715 Lisp_Object tail
, frame
;
719 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
721 /* From time to time see if we can unload some fonts. This also
722 frees all realized faces on all frames. Fonts needed by
723 faces will be loaded again when faces are realized again. */
724 clear_font_table_count
= 0;
726 FOR_EACH_FRAME (tail
, frame
)
730 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
732 free_all_realized_faces (frame
);
733 clear_font_table (f
);
739 /* Clear GCs of realized faces. */
740 FOR_EACH_FRAME (tail
, frame
)
745 clear_face_gcs (FRAME_FACE_CACHE (f
));
746 clear_image_cache (f
, 0);
750 #endif /* HAVE_X_WINDOWS */
754 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
755 "Clear face caches on all frames.\n\
756 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
758 Lisp_Object thorougly
;
760 clear_face_cache (!NILP (thorougly
));
766 #ifdef HAVE_X_WINDOWS
769 /* Remove those fonts from the font table of frame F that are not used
770 by fontsets. Called from clear_face_cache from time to time. */
776 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
778 Lisp_Object rest
, frame
;
781 xassert (FRAME_X_P (c
->f
));
783 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
784 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
786 /* For all frames with the same x_display_info as F, record
787 in `used' those fonts that are in use by fontsets. */
788 FOR_EACH_FRAME (rest
, frame
)
789 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
791 struct frame
*f
= XFRAME (frame
);
792 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
794 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
796 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
799 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
801 int idx
= info
->font_indexes
[j
];
808 /* Free those fonts that are not used by fontsets. */
809 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
810 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
812 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
814 /* Free names. In xfns.c there is a comment that full_name
815 should never be freed because it is always shared with
816 something else. I don't think this is true anymore---see
817 x_load_font. It's either equal to font_info->name or
818 allocated via xmalloc, and there seems to be no place in
819 the source files where full_name is transferred to another
821 if (font_info
->full_name
!= font_info
->name
)
822 xfree (font_info
->full_name
);
823 xfree (font_info
->name
);
827 XFreeFont (dpyinfo
->display
, font_info
->font
);
830 /* Mark font table slot free. */
831 font_info
->font
= NULL
;
832 font_info
->name
= font_info
->full_name
= NULL
;
837 #endif /* HAVE_X_WINDOWS */
841 /***********************************************************************
843 ***********************************************************************/
845 #ifdef HAVE_X_WINDOWS
847 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
848 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
849 A bitmap specification is either a string, a file name, or a list\n\
850 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
851 HEIGHT is its height, and DATA is a string containing the bits of\n\
852 the pixmap. Bits are stored row by row, each row occupies\n\
853 (WIDTH + 7)/8 bytes.")
859 if (STRINGP (object
))
860 /* If OBJECT is a string, it's a file name. */
862 else if (CONSP (object
))
864 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
865 HEIGHT must be integers > 0, and DATA must be string large
866 enough to hold a bitmap of the specified size. */
867 Lisp_Object width
, height
, data
;
869 height
= width
= data
= Qnil
;
873 width
= XCAR (object
);
874 object
= XCDR (object
);
877 height
= XCAR (object
);
878 object
= XCDR (object
);
880 data
= XCAR (object
);
884 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
886 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
888 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
893 return pixmap_p
? Qt
: Qnil
;
897 /* Load a bitmap according to NAME (which is either a file name or a
898 pixmap spec) for use on frame F. Value is the bitmap_id (see
899 xfns.c). If NAME is nil, return with a bitmap id of zero. If
900 bitmap cannot be loaded, display a message saying so, and return
901 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
902 if these pointers are not null. */
905 load_pixmap (f
, name
, w_ptr
, h_ptr
)
908 unsigned int *w_ptr
, *h_ptr
;
916 tem
= Fbitmap_spec_p (name
);
918 wrong_type_argument (Qbitmap_spec_p
, name
);
923 /* Decode a bitmap spec into a bitmap. */
928 w
= XINT (Fcar (name
));
929 h
= XINT (Fcar (Fcdr (name
)));
930 bits
= Fcar (Fcdr (Fcdr (name
)));
932 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
937 /* It must be a string -- a file name. */
938 bitmap_id
= x_create_bitmap_from_file (f
, name
);
944 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
955 ++npixmaps_allocated
;
958 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
961 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
967 #endif /* HAVE_X_WINDOWS */
971 /***********************************************************************
973 ***********************************************************************/
975 #ifdef HAVE_X_WINDOWS
977 /* Update the line_height of frame F. Return non-zero if line height
981 frame_update_line_height (f
)
984 int fontset
, line_height
, changed_p
;
986 fontset
= f
->output_data
.x
->fontset
;
988 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
990 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
992 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
993 f
->output_data
.x
->line_height
= line_height
;
997 #endif /* HAVE_X_WINDOWS */
1000 /***********************************************************************
1002 ***********************************************************************/
1004 #ifdef HAVE_X_WINDOWS
1006 /* Load font or fontset of face FACE which is used on frame F.
1007 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1008 fontset. FONT_NAME is the name of the font to load, if no fontset
1009 is used. It is null if no suitable font name could be determined
1013 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1019 struct font_info
*font_info
= NULL
;
1021 face
->font_info_id
= -1;
1022 face
->fontset
= fontset
;
1027 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1030 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1039 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1040 face
->font
= font_info
->font
;
1041 face
->font_name
= font_info
->full_name
;
1043 /* Make the registry part of the font name readily accessible.
1044 The registry is used to find suitable faces for unibyte text. */
1045 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1047 while (i
< 2 && --s
>= font_info
->full_name
)
1051 if (!STRINGP (face
->registry
)
1052 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1054 if (STRINGP (Vface_default_registry
)
1055 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1056 face
->registry
= Vface_default_registry
;
1058 face
->registry
= build_string (s
+ 1);
1061 else if (fontset
>= 0)
1062 add_to_log ("Unable to load ASCII font of fontset %d",
1063 make_number (fontset
), Qnil
);
1065 add_to_log ("Unable to load font %s",
1066 build_string (font_name
), Qnil
);
1069 #endif /* HAVE_X_WINDOWS */
1073 /***********************************************************************
1075 ***********************************************************************/
1077 /* A version of defined_color for non-X frames. */
1079 tty_defined_color (f
, color_name
, color_def
, alloc
)
1085 Lisp_Object color_desc
;
1086 int color_idx
= FACE_TTY_DEFAULT_COLOR
, red
= 0, green
= 0, blue
= 0;
1089 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1092 color_desc
= call1 (Qtty_color_desc
, build_string (color_name
));
1093 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1095 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1096 if (CONSP (XCDR (XCDR (color_desc
))))
1098 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1099 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1100 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1104 else if (NILP (Fsymbol_value (intern ("tty-color-alist"))))
1105 /* We were called early during startup, and the colors are not
1106 yet set up in tty-color-alist. Don't return a failure
1107 indication, since this produces the annoying "Unable to
1108 load color" messages in the *Messages* buffer. */
1111 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1113 if (strcmp (color_name
, "unspecified-fg") == 0)
1114 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1115 else if (strcmp (color_name
, "unspecified-bg") == 0)
1116 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1119 color_def
->pixel
= (unsigned long) color_idx
;
1120 color_def
->red
= red
;
1121 color_def
->green
= green
;
1122 color_def
->blue
= blue
;
1127 /* Decide if color named COLOR is valid for the display associated
1128 with the frame F; if so, return the rgb values in COLOR_DEF. If
1129 ALLOC is nonzero, allocate a new colormap cell.
1131 This does the right thing for any type of frame. */
1133 defined_color (f
, color_name
, color_def
, alloc
)
1139 if (!FRAME_WINDOW_P (f
))
1140 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1141 #ifdef HAVE_X_WINDOWS
1142 else if (FRAME_X_P (f
))
1143 return x_defined_color (f
, color_name
, color_def
, alloc
);
1146 else if (FRAME_W32_P (f
))
1147 /* FIXME: w32_defined_color doesn't exist! w32fns.c defines
1148 defined_color which needs to be renamed, and the declaration
1149 of color_def therein should be changed. */
1150 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1153 else if (FRAME_MAC_P (f
))
1154 /* FIXME: mac_defined_color doesn't exist! */
1155 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1161 /* Given the index of the tty color, return its name, a Lisp string. */
1164 tty_color_name (f
, idx
)
1170 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1172 Lisp_Object coldesc
= call1 (Qtty_color_by_index
, make_number (idx
));
1174 if (!NILP (coldesc
))
1175 return XCAR (coldesc
);
1178 /* We can have an MSDOG frame under -nw for a short window of
1179 opportunity before internal_terminal_init is called. DTRT. */
1180 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1181 return msdos_stdcolor_name (idx
);
1185 /* FIXME: When/if w32 supports colors in non-window mode, there should
1186 be a call here to a w32-specific function that returns the color
1187 by index using the default color mapping on a Windows console. */
1191 idx
== FACE_TTY_DEFAULT_FG_COLOR
? Qunspecified_fg
1192 : idx
== FACE_TTY_DEFAULT_BG_COLOR
? Qunspecified_bg
1196 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1197 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1200 face_color_gray_p (f
, color_name
)
1207 if (defined_color (f
, color_name
, &color
, 0))
1208 gray_p
= ((abs (color
.red
- color
.green
)
1209 < max (color
.red
, color
.green
) / 20)
1210 && (abs (color
.green
- color
.blue
)
1211 < max (color
.green
, color
.blue
) / 20)
1212 && (abs (color
.blue
- color
.red
)
1213 < max (color
.blue
, color
.red
) / 20));
1221 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1222 BACKGROUND_P non-zero means the color will be used as background
1226 face_color_supported_p (f
, color_name
, background_p
)
1234 XSETFRAME (frame
, f
);
1235 return (FRAME_WINDOW_P (f
)
1236 ? (!NILP (Fxw_display_color_p (frame
))
1237 || xstricmp (color_name
, "black") == 0
1238 || xstricmp (color_name
, "white") == 0
1240 && face_color_gray_p (f
, color_name
))
1241 || (!NILP (Fx_display_grayscale_p (frame
))
1242 && face_color_gray_p (f
, color_name
)))
1243 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1247 DEFUN ("face-color-gray-p", Fface_color_gray_p
, Sface_color_gray_p
, 1, 2, 0,
1248 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1249 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1250 If FRAME is nil or omitted, use the selected frame.")
1252 Lisp_Object color
, frame
;
1256 CHECK_FRAME (frame
, 0);
1257 CHECK_STRING (color
, 0);
1259 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1263 DEFUN ("face-color-supported-p", Fface_color_supported_p
,
1264 Sface_color_supported_p
, 2, 3, 0,
1265 "Return non-nil if COLOR can be displayed on FRAME.\n\
1266 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1267 If FRAME is nil or omitted, use the selected frame.\n\
1268 COLOR must be a valid color name.")
1269 (frame
, color
, background_p
)
1270 Lisp_Object frame
, color
, background_p
;
1274 CHECK_FRAME (frame
, 0);
1275 CHECK_STRING (color
, 0);
1277 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1282 /* Load color with name NAME for use by face FACE on frame F.
1283 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1284 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1285 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1286 pixel color. If color cannot be loaded, display a message, and
1287 return the foreground, background or underline color of F, but
1288 record that fact in flags of the face so that we don't try to free
1292 load_color (f
, face
, name
, target_index
)
1296 enum lface_attribute_index target_index
;
1300 xassert (STRINGP (name
));
1301 xassert (target_index
== LFACE_FOREGROUND_INDEX
1302 || target_index
== LFACE_BACKGROUND_INDEX
1303 || target_index
== LFACE_UNDERLINE_INDEX
1304 || target_index
== LFACE_OVERLINE_INDEX
1305 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1306 || target_index
== LFACE_BOX_INDEX
);
1308 /* if the color map is full, defined_color will return a best match
1309 to the values in an existing cell. */
1310 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1312 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1314 switch (target_index
)
1316 case LFACE_FOREGROUND_INDEX
:
1317 face
->foreground_defaulted_p
= 1;
1318 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1321 case LFACE_BACKGROUND_INDEX
:
1322 face
->background_defaulted_p
= 1;
1323 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1326 case LFACE_UNDERLINE_INDEX
:
1327 face
->underline_defaulted_p
= 1;
1328 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1331 case LFACE_OVERLINE_INDEX
:
1332 face
->overline_color_defaulted_p
= 1;
1333 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1336 case LFACE_STRIKE_THROUGH_INDEX
:
1337 face
->strike_through_color_defaulted_p
= 1;
1338 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1341 case LFACE_BOX_INDEX
:
1342 face
->box_color_defaulted_p
= 1;
1343 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1352 ++ncolors_allocated
;
1358 #ifdef HAVE_X_WINDOWS
1360 /* Load colors for face FACE which is used on frame F. Colors are
1361 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1362 of ATTRS. If the background color specified is not supported on F,
1363 try to emulate gray colors with a stipple from Vface_default_stipple. */
1366 load_face_colors (f
, face
, attrs
)
1373 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1374 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1376 /* Swap colors if face is inverse-video. */
1377 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1385 /* Check for support for foreground, not for background because
1386 face_color_supported_p is smart enough to know that grays are
1387 "supported" as background because we are supposed to use stipple
1389 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1390 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1392 x_destroy_bitmap (f
, face
->stipple
);
1393 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1394 &face
->pixmap_w
, &face
->pixmap_h
);
1397 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1398 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1402 /* Free color PIXEL on frame F. */
1405 unload_color (f
, pixel
)
1407 unsigned long pixel
;
1409 Display
*dpy
= FRAME_X_DISPLAY (f
);
1410 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1412 if (pixel
== BLACK_PIX_DEFAULT (f
)
1413 || pixel
== WHITE_PIX_DEFAULT (f
))
1418 /* If display has an immutable color map, freeing colors is not
1419 necessary and some servers don't allow it. So don't do it. */
1420 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1422 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1423 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1430 /* Free colors allocated for FACE. */
1433 free_face_colors (f
, face
)
1437 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1439 /* If display has an immutable color map, freeing colors is not
1440 necessary and some servers don't allow it. So don't do it. */
1441 if (class != StaticColor
1442 && class != StaticGray
1443 && class != TrueColor
)
1449 dpy
= FRAME_X_DISPLAY (f
);
1450 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1452 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1453 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1454 && !face
->foreground_defaulted_p
)
1456 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1457 IF_DEBUG (--ncolors_allocated
);
1460 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1461 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1462 && !face
->background_defaulted_p
)
1464 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1465 IF_DEBUG (--ncolors_allocated
);
1468 if (face
->underline_p
1469 && !face
->underline_defaulted_p
1470 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1471 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1473 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1474 IF_DEBUG (--ncolors_allocated
);
1477 if (face
->overline_p
1478 && !face
->overline_color_defaulted_p
1479 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1480 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1482 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1483 IF_DEBUG (--ncolors_allocated
);
1486 if (face
->strike_through_p
1487 && !face
->strike_through_color_defaulted_p
1488 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1489 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1491 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1492 IF_DEBUG (--ncolors_allocated
);
1495 if (face
->box
!= FACE_NO_BOX
1496 && !face
->box_color_defaulted_p
1497 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1498 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1500 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1501 IF_DEBUG (--ncolors_allocated
);
1507 #endif /* HAVE_X_WINDOWS */
1511 /***********************************************************************
1513 ***********************************************************************/
1515 /* An enumerator for each field of an XLFD font name. */
1536 /* An enumerator for each possible slant value of a font. Taken from
1537 the XLFD specification. */
1545 XLFD_SLANT_REVERSE_ITALIC
,
1546 XLFD_SLANT_REVERSE_OBLIQUE
,
1550 /* Relative font weight according to XLFD documentation. */
1554 XLFD_WEIGHT_UNKNOWN
,
1555 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1556 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1557 XLFD_WEIGHT_LIGHT
, /* 30 */
1558 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1559 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1560 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1561 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1562 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1563 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1566 /* Relative proportionate width. */
1570 XLFD_SWIDTH_UNKNOWN
,
1571 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1572 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1573 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1574 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1575 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1576 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1577 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1578 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1579 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1582 /* Structure used for tables mapping XLFD weight, slant, and width
1583 names to numeric and symbolic values. */
1589 Lisp_Object
*symbol
;
1592 /* Table of XLFD slant names and their numeric and symbolic
1593 representations. This table must be sorted by slant names in
1596 static struct table_entry slant_table
[] =
1598 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1599 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1600 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1601 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1602 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1603 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1606 /* Table of XLFD weight names. This table must be sorted by weight
1607 names in ascending order. */
1609 static struct table_entry weight_table
[] =
1611 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1612 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1613 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1614 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1615 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1616 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1617 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1618 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1619 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1620 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1621 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1622 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1623 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1624 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1625 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1628 /* Table of XLFD width names. This table must be sorted by width
1629 names in ascending order. */
1631 static struct table_entry swidth_table
[] =
1633 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1634 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1635 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1636 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1637 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1638 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1639 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1640 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1641 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1642 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1643 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1644 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1645 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1646 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1647 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1650 /* Structure used to hold the result of splitting font names in XLFD
1651 format into their fields. */
1655 /* The original name which is modified destructively by
1656 split_font_name. The pointer is kept here to be able to free it
1657 if it was allocated from the heap. */
1660 /* Font name fields. Each vector element points into `name' above.
1661 Fields are NUL-terminated. */
1662 char *fields
[XLFD_LAST
];
1664 /* Numeric values for those fields that interest us. See
1665 split_font_name for which these are. */
1666 int numeric
[XLFD_LAST
];
1669 /* The frame in effect when sorting font names. Set temporarily in
1670 sort_fonts so that it is available in font comparison functions. */
1672 static struct frame
*font_frame
;
1674 /* Order by which font selection chooses fonts. The default values
1675 mean `first, find a best match for the font width, then for the
1676 font height, then for weight, then for slant.' This variable can be
1677 set via set-face-font-sort-order. */
1679 static int font_sort_order
[4];
1682 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1683 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1684 is a pointer to the matching table entry or null if no table entry
1687 static struct table_entry
*
1688 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1689 struct table_entry
*table
;
1691 struct font_name
*font
;
1694 /* Function split_font_name converts fields to lower-case, so there
1695 is no need to use xstrlwr or xstricmp here. */
1696 char *s
= font
->fields
[field_index
];
1697 int low
, mid
, high
, cmp
;
1704 mid
= (low
+ high
) / 2;
1705 cmp
= strcmp (table
[mid
].name
, s
);
1719 /* Return a numeric representation for font name field
1720 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1721 has DIM entries. Value is the numeric value found or DFLT if no
1722 table entry matches. This function is used to translate weight,
1723 slant, and swidth names of XLFD font names to numeric values. */
1726 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1727 struct table_entry
*table
;
1729 struct font_name
*font
;
1733 struct table_entry
*p
;
1734 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1735 return p
? p
->numeric
: dflt
;
1739 /* Return a symbolic representation for font name field
1740 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1741 has DIM entries. Value is the symbolic value found or DFLT if no
1742 table entry matches. This function is used to translate weight,
1743 slant, and swidth names of XLFD font names to symbols. */
1745 static INLINE Lisp_Object
1746 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1747 struct table_entry
*table
;
1749 struct font_name
*font
;
1753 struct table_entry
*p
;
1754 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1755 return p
? *p
->symbol
: dflt
;
1759 /* Return a numeric value for the slant of the font given by FONT. */
1762 xlfd_numeric_slant (font
)
1763 struct font_name
*font
;
1765 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1766 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1770 /* Return a symbol representing the weight of the font given by FONT. */
1772 static INLINE Lisp_Object
1773 xlfd_symbolic_slant (font
)
1774 struct font_name
*font
;
1776 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1777 font
, XLFD_SLANT
, Qnormal
);
1781 /* Return a numeric value for the weight of the font given by FONT. */
1784 xlfd_numeric_weight (font
)
1785 struct font_name
*font
;
1787 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1788 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1792 /* Return a symbol representing the slant of the font given by FONT. */
1794 static INLINE Lisp_Object
1795 xlfd_symbolic_weight (font
)
1796 struct font_name
*font
;
1798 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1799 font
, XLFD_WEIGHT
, Qnormal
);
1803 /* Return a numeric value for the swidth of the font whose XLFD font
1804 name fields are found in FONT. */
1807 xlfd_numeric_swidth (font
)
1808 struct font_name
*font
;
1810 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1811 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1815 /* Return a symbolic value for the swidth of FONT. */
1817 static INLINE Lisp_Object
1818 xlfd_symbolic_swidth (font
)
1819 struct font_name
*font
;
1821 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1822 font
, XLFD_SWIDTH
, Qnormal
);
1826 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1827 entries. Value is a pointer to the matching table entry or null if
1828 no element of TABLE contains SYMBOL. */
1830 static struct table_entry
*
1831 face_value (table
, dim
, symbol
)
1832 struct table_entry
*table
;
1838 xassert (SYMBOLP (symbol
));
1840 for (i
= 0; i
< dim
; ++i
)
1841 if (EQ (*table
[i
].symbol
, symbol
))
1844 return i
< dim
? table
+ i
: NULL
;
1848 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1849 entries. Value is -1 if SYMBOL is not found in TABLE. */
1852 face_numeric_value (table
, dim
, symbol
)
1853 struct table_entry
*table
;
1857 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1858 return p
? p
->numeric
: -1;
1862 /* Return a numeric value representing the weight specified by Lisp
1863 symbol WEIGHT. Value is one of the enumerators of enum
1867 face_numeric_weight (weight
)
1870 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1874 /* Return a numeric value representing the slant specified by Lisp
1875 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1878 face_numeric_slant (slant
)
1881 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1885 /* Return a numeric value representing the swidth specified by Lisp
1886 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1889 face_numeric_swidth (width
)
1892 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1896 #ifdef HAVE_X_WINDOWS
1898 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1902 struct font_name
*font
;
1904 /* Function split_font_name converts fields to lower-case, so there
1905 is no need to use tolower here. */
1906 return *font
->fields
[XLFD_SPACING
] != 'p';
1910 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1912 The actual height of the font when displayed on F depends on the
1913 resolution of both the font and frame. For example, a 10pt font
1914 designed for a 100dpi display will display larger than 10pt on a
1915 75dpi display. (It's not unusual to use fonts not designed for the
1916 display one is using. For example, some intlfonts are available in
1917 72dpi versions, only.)
1919 Value is the real point size of FONT on frame F, or 0 if it cannot
1923 xlfd_point_size (f
, font
)
1925 struct font_name
*font
;
1927 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1928 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1929 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1932 if (font_resy
== 0 || font_pt
== 0)
1935 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1941 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1942 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1943 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1944 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1945 zero if the font name doesn't have the format we expect. The
1946 expected format is a font name that starts with a `-' and has
1947 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1948 forms of font names where certain field contents are enclosed in
1949 square brackets. We don't support that, for now. */
1952 split_font_name (f
, font
, numeric_p
)
1954 struct font_name
*font
;
1960 if (*font
->name
== '-')
1962 char *p
= xstrlwr (font
->name
) + 1;
1964 while (i
< XLFD_LAST
)
1966 font
->fields
[i
] = p
;
1969 while (*p
&& *p
!= '-')
1979 success_p
= i
== XLFD_LAST
;
1981 /* If requested, and font name was in the expected format,
1982 compute numeric values for some fields. */
1983 if (numeric_p
&& success_p
)
1985 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1986 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1987 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1988 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1989 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
1996 /* Build an XLFD font name from font name fields in FONT. Value is a
1997 pointer to the font name, which is allocated via xmalloc. */
2000 build_font_name (font
)
2001 struct font_name
*font
;
2005 char *font_name
= (char *) xmalloc (size
);
2006 int total_length
= 0;
2008 for (i
= 0; i
< XLFD_LAST
; ++i
)
2010 /* Add 1 because of the leading `-'. */
2011 int len
= strlen (font
->fields
[i
]) + 1;
2013 /* Reallocate font_name if necessary. Add 1 for the final
2015 if (total_length
+ len
+ 1 >= size
)
2017 int new_size
= max (2 * size
, size
+ len
+ 1);
2018 int sz
= new_size
* sizeof *font_name
;
2019 font_name
= (char *) xrealloc (font_name
, sz
);
2023 font_name
[total_length
] = '-';
2024 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2025 total_length
+= len
;
2028 font_name
[total_length
] = 0;
2033 /* Free an array FONTS of N font_name structures. This frees FONTS
2034 itself and all `name' fields in its elements. */
2037 free_font_names (fonts
, n
)
2038 struct font_name
*fonts
;
2042 xfree (fonts
[--n
].name
);
2047 /* Sort vector FONTS of font_name structures which contains NFONTS
2048 elements using qsort and comparison function CMPFN. F is the frame
2049 on which the fonts will be used. The global variable font_frame
2050 is temporarily set to F to make it available in CMPFN. */
2053 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2055 struct font_name
*fonts
;
2057 int (*cmpfn
) P_ ((const void *, const void *));
2060 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2065 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2066 display in x_display_list. FONTS is a pointer to a vector of
2067 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2068 alternative patterns from Valternate_fontname_alist if no fonts are
2069 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2072 For all fonts found, set FONTS[i].name to the name of the font,
2073 allocated via xmalloc, and split font names into fields. Ignore
2074 fonts that we can't parse. Value is the number of fonts found.
2076 This is similar to x_list_fonts. The differences are:
2078 1. It avoids consing.
2079 2. It never calls XLoadQueryFont. */
2082 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2086 struct font_name
*fonts
;
2087 int nfonts
, try_alternatives_p
;
2088 int scalable_fonts_p
;
2090 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2094 /* Get the list of fonts matching PATTERN from the X server. */
2096 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2101 /* Make a copy of the font names we got from X, and
2102 split them into fields. */
2103 for (i
= j
= 0; i
< n
; ++i
)
2105 /* Make a copy of the font name. */
2106 fonts
[j
].name
= xstrdup (names
[i
]);
2108 /* Ignore fonts having a name that we can't parse. */
2109 if (!split_font_name (f
, fonts
+ j
, 1))
2110 xfree (fonts
[j
].name
);
2111 else if (font_scalable_p (fonts
+ j
))
2114 if (!scalable_fonts_p
2115 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2116 xfree (fonts
[j
].name
);
2119 #else /* !SCALABLE_FONTS */
2120 /* Always ignore scalable fonts. */
2121 xfree (fonts
[j
].name
);
2122 #endif /* !SCALABLE_FONTS */
2130 /* Free font names. */
2132 XFreeFontNames (names
);
2137 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2138 if (n
== 0 && try_alternatives_p
)
2140 Lisp_Object list
= Valternate_fontname_alist
;
2142 while (CONSP (list
))
2144 Lisp_Object entry
= XCAR (list
);
2146 && STRINGP (XCAR (entry
))
2147 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2154 Lisp_Object patterns
= XCAR (list
);
2157 while (CONSP (patterns
)
2158 /* If list is screwed up, give up. */
2159 && (name
= XCAR (patterns
),
2161 /* Ignore patterns equal to PATTERN because we tried that
2162 already with no success. */
2163 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2164 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2168 patterns
= XCDR (patterns
);
2176 /* Determine the first font matching PATTERN on frame F. Return in
2177 *FONT the matching font name, split into fields. Value is non-zero
2178 if a match was found. */
2181 first_font_matching (f
, pattern
, font
)
2184 struct font_name
*font
;
2187 struct font_name
*fonts
;
2189 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2190 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2194 bcopy (&fonts
[0], font
, sizeof *font
);
2196 fonts
[0].name
= NULL
;
2197 free_font_names (fonts
, nfonts
);
2204 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2205 using comparison function CMPFN. Value is the number of fonts
2206 found. If value is non-zero, *FONTS is set to a vector of
2207 font_name structures allocated from the heap containing matching
2208 fonts. Each element of *FONTS contains a name member that is also
2209 allocated from the heap. Font names in these structures are split
2210 into fields. Use free_font_names to free such an array. */
2213 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2216 int (*cmpfn
) P_ ((const void *, const void *));
2217 struct font_name
**fonts
;
2221 /* Get the list of fonts matching pattern. 100 should suffice. */
2222 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2223 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2224 nfonts
= XFASTINT (Vfont_list_limit
);
2226 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2228 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2230 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2233 /* Sort the resulting array and return it in *FONTS. If no
2234 fonts were found, make sure to set *FONTS to null. */
2236 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2247 /* Compare two font_name structures *A and *B. Value is analogous to
2248 strcmp. Sort order is given by the global variable
2249 font_sort_order. Font names are sorted so that, everything else
2250 being equal, fonts with a resolution closer to that of the frame on
2251 which they are used are listed first. The global variable
2252 font_frame is the frame on which we operate. */
2255 cmp_font_names (a
, b
)
2258 struct font_name
*x
= (struct font_name
*) a
;
2259 struct font_name
*y
= (struct font_name
*) b
;
2262 /* All strings have been converted to lower-case by split_font_name,
2263 so we can use strcmp here. */
2264 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2269 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2271 int j
= font_sort_order
[i
];
2272 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2277 /* Everything else being equal, we prefer fonts with an
2278 y-resolution closer to that of the frame. */
2279 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2280 int x_resy
= x
->numeric
[XLFD_RESY
];
2281 int y_resy
= y
->numeric
[XLFD_RESY
];
2282 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2290 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2291 is non-null list fonts matching that pattern. Otherwise, if
2292 REGISTRY_AND_ENCODING is non-null return only fonts with that
2293 registry and encoding, otherwise return fonts of any registry and
2294 encoding. Set *FONTS to a vector of font_name structures allocated
2295 from the heap containing the fonts found. Value is the number of
2299 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2303 char *registry_and_encoding
;
2304 struct font_name
**fonts
;
2306 if (pattern
== NULL
)
2311 if (registry_and_encoding
== NULL
)
2312 registry_and_encoding
= "*";
2314 pattern
= (char *) alloca (strlen (family
)
2315 + strlen (registry_and_encoding
)
2317 if (index (family
, '-'))
2318 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2320 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2323 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2327 /* Remove elements from LIST whose cars are `equal'. Called from
2328 x-family-fonts and x-font-family-list to remove duplicate font
2332 remove_duplicates (list
)
2335 Lisp_Object tail
= list
;
2337 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2339 Lisp_Object next
= XCDR (tail
);
2340 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2341 XCDR (tail
) = XCDR (next
);
2348 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2349 "Return a list of available fonts of family FAMILY on FRAME.\n\
2350 If FAMILY is omitted or nil, list all families.\n\
2351 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2353 If FRAME is omitted or nil, use the selected frame.\n\
2354 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2355 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2356 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2357 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2358 width, weight and slant of the font. These symbols are the same as for\n\
2359 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2360 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2361 giving the registry and encoding of the font.\n\
2362 The result list is sorted according to the current setting of\n\
2363 the face font sort order.")
2365 Lisp_Object family
, frame
;
2367 struct frame
*f
= check_x_frame (frame
);
2368 struct font_name
*fonts
;
2371 struct gcpro gcpro1
;
2372 char *family_pattern
;
2375 family_pattern
= "*";
2378 CHECK_STRING (family
, 1);
2379 family_pattern
= LSTRDUPA (family
);
2384 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2385 for (i
= nfonts
- 1; i
>= 0; --i
)
2387 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2390 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2392 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2393 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2394 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2395 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2396 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2397 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2398 tem
= build_font_name (fonts
+ i
);
2399 ASET (v
, 6, build_string (tem
));
2400 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2401 fonts
[i
].fields
[XLFD_ENCODING
]);
2402 ASET (v
, 7, build_string (tem
));
2405 result
= Fcons (v
, result
);
2410 remove_duplicates (result
);
2411 free_font_names (fonts
, nfonts
);
2417 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2419 "Return a list of available font families on FRAME.\n\
2420 If FRAME is omitted or nil, use the selected frame.\n\
2421 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2422 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2427 struct frame
*f
= check_x_frame (frame
);
2429 struct font_name
*fonts
;
2431 struct gcpro gcpro1
;
2432 int count
= specpdl_ptr
- specpdl
;
2435 /* Let's consider all fonts. Increase the limit for matching
2436 fonts until we have them all. */
2439 specbind (intern ("font-list-limit"), make_number (limit
));
2440 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2442 if (nfonts
== limit
)
2444 free_font_names (fonts
, nfonts
);
2453 for (i
= nfonts
- 1; i
>= 0; --i
)
2454 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2455 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2458 remove_duplicates (result
);
2459 free_font_names (fonts
, nfonts
);
2461 return unbind_to (count
, result
);
2465 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2466 "Return a list of the names of available fonts matching PATTERN.\n\
2467 If optional arguments FACE and FRAME are specified, return only fonts\n\
2468 the same size as FACE on FRAME.\n\
2469 PATTERN is a string, perhaps with wildcard characters;\n\
2470 the * character matches any substring, and\n\
2471 the ? character matches any single character.\n\
2472 PATTERN is case-insensitive.\n\
2473 FACE is a face name--a symbol.\n\
2475 The return value is a list of strings, suitable as arguments to\n\
2478 Fonts Emacs can't use may or may not be excluded\n\
2479 even if they match PATTERN and FACE.\n\
2480 The optional fourth argument MAXIMUM sets a limit on how many\n\
2481 fonts to match. The first MAXIMUM fonts are reported.\n\
2482 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2483 occupied by a character of a font. In that case, return only fonts\n\
2484 the WIDTH times as wide as FACE on FRAME.")
2485 (pattern
, face
, frame
, maximum
, width
)
2486 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2493 CHECK_STRING (pattern
, 0);
2499 CHECK_NATNUM (maximum
, 0);
2500 maxnames
= XINT (maximum
);
2504 CHECK_NUMBER (width
, 4);
2506 /* We can't simply call check_x_frame because this function may be
2507 called before any frame is created. */
2508 f
= frame_or_selected_frame (frame
, 2);
2511 /* Perhaps we have not yet created any frame. */
2516 /* Determine the width standard for comparison with the fonts we find. */
2522 /* This is of limited utility since it works with character
2523 widths. Keep it for compatibility. --gerd. */
2524 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2525 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2528 size
= face
->font
->max_bounds
.width
;
2530 size
= FRAME_FONT (f
)->max_bounds
.width
;
2533 size
*= XINT (width
);
2537 Lisp_Object args
[2];
2539 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2541 /* We don't have to check fontsets. */
2543 args
[1] = list_fontsets (f
, pattern
, size
);
2544 return Fnconc (2, args
);
2548 #endif /* HAVE_X_WINDOWS */
2552 /***********************************************************************
2554 ***********************************************************************/
2556 /* Access face attributes of face FACE, a Lisp vector. */
2558 #define LFACE_FAMILY(LFACE) \
2559 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2560 #define LFACE_HEIGHT(LFACE) \
2561 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2562 #define LFACE_WEIGHT(LFACE) \
2563 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2564 #define LFACE_SLANT(LFACE) \
2565 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2566 #define LFACE_UNDERLINE(LFACE) \
2567 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2568 #define LFACE_INVERSE(LFACE) \
2569 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2570 #define LFACE_FOREGROUND(LFACE) \
2571 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2572 #define LFACE_BACKGROUND(LFACE) \
2573 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2574 #define LFACE_STIPPLE(LFACE) \
2575 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2576 #define LFACE_SWIDTH(LFACE) \
2577 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2578 #define LFACE_OVERLINE(LFACE) \
2579 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2580 #define LFACE_STRIKE_THROUGH(LFACE) \
2581 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2582 #define LFACE_BOX(LFACE) \
2583 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2585 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2586 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2588 #define LFACEP(LFACE) \
2590 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2591 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2596 /* Check consistency of Lisp face attribute vector ATTRS. */
2599 check_lface_attrs (attrs
)
2602 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2603 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2604 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2605 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2606 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2607 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2608 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2609 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2610 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2611 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2612 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2613 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2614 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2615 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2616 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2617 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2618 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2619 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2620 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2621 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2622 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2623 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2624 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2625 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2626 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2627 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2628 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2629 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2630 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2631 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2632 #ifdef HAVE_WINDOW_SYSTEM
2633 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2634 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2635 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2640 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2648 xassert (LFACEP (lface
));
2649 check_lface_attrs (XVECTOR (lface
)->contents
);
2653 #else /* GLYPH_DEBUG == 0 */
2655 #define check_lface_attrs(attrs) (void) 0
2656 #define check_lface(lface) (void) 0
2658 #endif /* GLYPH_DEBUG == 0 */
2661 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2662 to make it a symvol. If FACE_NAME is an alias for another face,
2663 return that face's name. */
2666 resolve_face_name (face_name
)
2667 Lisp_Object face_name
;
2669 Lisp_Object aliased
;
2671 if (STRINGP (face_name
))
2672 face_name
= intern (XSTRING (face_name
)->data
);
2676 aliased
= Fget (face_name
, Qface_alias
);
2680 face_name
= aliased
;
2687 /* Return the face definition of FACE_NAME on frame F. F null means
2688 return the global definition. FACE_NAME may be a string or a
2689 symbol (apparently Emacs 20.2 allows strings as face names in face
2690 text properties; ediff uses that). If FACE_NAME is an alias for
2691 another face, return that face's definition. If SIGNAL_P is
2692 non-zero, signal an error if FACE_NAME is not a valid face name.
2693 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2696 static INLINE Lisp_Object
2697 lface_from_face_name (f
, face_name
, signal_p
)
2699 Lisp_Object face_name
;
2704 face_name
= resolve_face_name (face_name
);
2707 lface
= assq_no_quit (face_name
, f
->face_alist
);
2709 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2712 lface
= XCDR (lface
);
2714 signal_error ("Invalid face", face_name
);
2716 check_lface (lface
);
2721 /* Get face attributes of face FACE_NAME from frame-local faces on
2722 frame F. Store the resulting attributes in ATTRS which must point
2723 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2724 is non-zero, signal an error if FACE_NAME does not name a face.
2725 Otherwise, value is zero if FACE_NAME is not a face. */
2728 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2730 Lisp_Object face_name
;
2737 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2740 bcopy (XVECTOR (lface
)->contents
, attrs
,
2741 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2751 /* Non-zero if all attributes in face attribute vector ATTRS are
2752 specified, i.e. are non-nil. */
2755 lface_fully_specified_p (attrs
)
2760 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2761 if (UNSPECIFIEDP (attrs
[i
]))
2764 return i
== LFACE_VECTOR_SIZE
;
2768 #ifdef HAVE_X_WINDOWS
2770 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2771 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2772 LFACE. MAY_FAIL_P non-zero means return 0 if FONT_NAME isn't a
2773 valid font name; otherwise this function tries to use a reasonable
2776 Ignore fields of FONT_NAME containing wildcards. Value is zero if
2777 not successful because FONT_NAME was not in a valid format and
2778 MAY_FAIL_P was non-zero. A valid format is one that is suitable
2779 for split_font_name, see the comment there. */
2782 set_lface_from_font_name (f
, lface
, font_name
, force_p
, may_fail_p
)
2786 int force_p
, may_fail_p
;
2788 struct font_name font
;
2791 int free_font_name_p
= 0;
2792 int have_font_p
= 0;
2794 /* If FONT_NAME contains wildcards, use the first matching font. */
2795 if (index (font_name
, '*') || index (font_name
, '?'))
2797 if (first_font_matching (f
, font_name
, &font
))
2798 free_font_name_p
= have_font_p
= 1;
2802 font
.name
= STRDUPA (font_name
);
2803 if (split_font_name (f
, &font
, 1))
2807 /* The font name may be something like `6x13'. Make
2808 sure we use the full name. */
2809 struct font_info
*font_info
;
2812 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2813 CHARSET_ASCII
, font_name
, -1);
2816 font
.name
= STRDUPA (font_info
->full_name
);
2817 split_font_name (f
, &font
, 1);
2824 /* If FONT_NAME is completely bogus try to use something reasonable
2825 if this function must succeed. Otherwise, give up. */
2830 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2832 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2834 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2836 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2838 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2840 || first_font_matching (f
, "fixed", &font
))
2841 free_font_name_p
= 1;
2847 /* Set attributes only if unspecified, otherwise face defaults for
2848 new frames would never take effect. */
2850 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2852 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2853 + strlen (font
.fields
[XLFD_FOUNDRY
])
2855 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2856 font
.fields
[XLFD_FAMILY
]);
2857 LFACE_FAMILY (lface
) = build_string (buffer
);
2860 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2862 pt
= xlfd_point_size (f
, &font
);
2864 LFACE_HEIGHT (lface
) = make_number (pt
);
2867 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2868 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2870 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2871 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2873 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2874 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2876 if (free_font_name_p
)
2882 #endif /* HAVE_X_WINDOWS */
2885 /* Merge two Lisp face attribute vectors FROM and TO and store the
2886 resulting attributes in TO. Every non-nil attribute of FROM
2887 overrides the corresponding attribute of TO. */
2890 merge_face_vectors (from
, to
)
2891 Lisp_Object
*from
, *to
;
2894 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2895 if (!UNSPECIFIEDP (from
[i
]))
2900 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2901 is a face property, determine the resulting face attributes on
2902 frame F, and store them in TO. PROP may be a single face
2903 specification or a list of such specifications. Each face
2904 specification can be
2906 1. A symbol or string naming a Lisp face.
2908 2. A property list of the form (KEYWORD VALUE ...) where each
2909 KEYWORD is a face attribute name, and value is an appropriate value
2912 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2913 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2914 for compatibility with 20.2.
2916 Face specifications earlier in lists take precedence over later
2920 merge_face_vector_with_property (f
, to
, prop
)
2927 Lisp_Object first
= XCAR (prop
);
2929 if (EQ (first
, Qforeground_color
)
2930 || EQ (first
, Qbackground_color
))
2932 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2933 . COLOR). COLOR must be a string. */
2934 Lisp_Object color_name
= XCDR (prop
);
2935 Lisp_Object color
= first
;
2937 if (STRINGP (color_name
))
2939 if (EQ (color
, Qforeground_color
))
2940 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2942 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2945 add_to_log ("Invalid face color", color_name
, Qnil
);
2947 else if (SYMBOLP (first
)
2948 && *XSYMBOL (first
)->name
->data
== ':')
2950 /* Assume this is the property list form. */
2951 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2953 Lisp_Object keyword
= XCAR (prop
);
2954 Lisp_Object value
= XCAR (XCDR (prop
));
2956 if (EQ (keyword
, QCfamily
))
2958 if (STRINGP (value
))
2959 to
[LFACE_FAMILY_INDEX
] = value
;
2961 add_to_log ("Illegal face font family", value
, Qnil
);
2963 else if (EQ (keyword
, QCheight
))
2965 if (INTEGERP (value
))
2966 to
[LFACE_HEIGHT_INDEX
] = value
;
2968 add_to_log ("Illegal face font height", value
, Qnil
);
2970 else if (EQ (keyword
, QCweight
))
2973 && face_numeric_weight (value
) >= 0)
2974 to
[LFACE_WEIGHT_INDEX
] = value
;
2976 add_to_log ("Illegal face weight", value
, Qnil
);
2978 else if (EQ (keyword
, QCslant
))
2981 && face_numeric_slant (value
) >= 0)
2982 to
[LFACE_SLANT_INDEX
] = value
;
2984 add_to_log ("Illegal face slant", value
, Qnil
);
2986 else if (EQ (keyword
, QCunderline
))
2991 to
[LFACE_UNDERLINE_INDEX
] = value
;
2993 add_to_log ("Illegal face underline", value
, Qnil
);
2995 else if (EQ (keyword
, QCoverline
))
3000 to
[LFACE_OVERLINE_INDEX
] = value
;
3002 add_to_log ("Illegal face overline", value
, Qnil
);
3004 else if (EQ (keyword
, QCstrike_through
))
3009 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3011 add_to_log ("Illegal face strike-through", value
, Qnil
);
3013 else if (EQ (keyword
, QCbox
))
3016 value
= make_number (1);
3017 if (INTEGERP (value
)
3021 to
[LFACE_BOX_INDEX
] = value
;
3023 add_to_log ("Illegal face box", value
, Qnil
);
3025 else if (EQ (keyword
, QCinverse_video
)
3026 || EQ (keyword
, QCreverse_video
))
3028 if (EQ (value
, Qt
) || NILP (value
))
3029 to
[LFACE_INVERSE_INDEX
] = value
;
3031 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3033 else if (EQ (keyword
, QCforeground
))
3035 if (STRINGP (value
))
3036 to
[LFACE_FOREGROUND_INDEX
] = value
;
3038 add_to_log ("Illegal face foreground", value
, Qnil
);
3040 else if (EQ (keyword
, QCbackground
))
3042 if (STRINGP (value
))
3043 to
[LFACE_BACKGROUND_INDEX
] = value
;
3045 add_to_log ("Illegal face background", value
, Qnil
);
3047 else if (EQ (keyword
, QCstipple
))
3049 #ifdef HAVE_X_WINDOWS
3050 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3051 if (!NILP (pixmap_p
))
3052 to
[LFACE_STIPPLE_INDEX
] = value
;
3054 add_to_log ("Illegal face stipple", value
, Qnil
);
3057 else if (EQ (keyword
, QCwidth
))
3060 && face_numeric_swidth (value
) >= 0)
3061 to
[LFACE_SWIDTH_INDEX
] = value
;
3063 add_to_log ("Illegal face width", value
, Qnil
);
3066 add_to_log ("Invalid attribute %s in face property",
3069 prop
= XCDR (XCDR (prop
));
3074 /* This is a list of face specs. Specifications at the
3075 beginning of the list take precedence over later
3076 specifications, so we have to merge starting with the
3077 last specification. */
3078 Lisp_Object next
= XCDR (prop
);
3080 merge_face_vector_with_property (f
, to
, next
);
3081 merge_face_vector_with_property (f
, to
, first
);
3086 /* PROP ought to be a face name. */
3087 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3089 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3091 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3096 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3097 Sinternal_make_lisp_face
, 1, 2, 0,
3098 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3099 If FACE was not known as a face before, create a new one.\n\
3100 If optional argument FRAME is specified, make a frame-local face\n\
3101 for that frame. Otherwise operate on the global face definition.\n\
3102 Value is a vector of face attributes.")
3104 Lisp_Object face
, frame
;
3106 Lisp_Object global_lface
, lface
;
3110 CHECK_SYMBOL (face
, 0);
3111 global_lface
= lface_from_face_name (NULL
, face
, 0);
3115 CHECK_LIVE_FRAME (frame
, 1);
3117 lface
= lface_from_face_name (f
, face
, 0);
3120 f
= NULL
, lface
= Qnil
;
3122 /* Add a global definition if there is none. */
3123 if (NILP (global_lface
))
3125 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3127 XVECTOR (global_lface
)->contents
[0] = Qface
;
3128 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3129 Vface_new_frame_defaults
);
3131 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3132 face id to Lisp face is given by the vector lface_id_to_name.
3133 The mapping from Lisp face to Lisp face id is given by the
3134 property `face' of the Lisp face name. */
3135 if (next_lface_id
== lface_id_to_name_size
)
3137 int new_size
= max (50, 2 * lface_id_to_name_size
);
3138 int sz
= new_size
* sizeof *lface_id_to_name
;
3139 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3140 lface_id_to_name_size
= new_size
;
3143 lface_id_to_name
[next_lface_id
] = face
;
3144 Fput (face
, Qface
, make_number (next_lface_id
));
3148 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3149 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3151 /* Add a frame-local definition. */
3156 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3158 XVECTOR (lface
)->contents
[0] = Qface
;
3159 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3162 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3163 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3166 lface
= global_lface
;
3168 xassert (LFACEP (lface
));
3169 check_lface (lface
);
3174 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3175 Sinternal_lisp_face_p
, 1, 2, 0,
3176 "Return non-nil if FACE names a face.\n\
3177 If optional second parameter FRAME is non-nil, check for the\n\
3178 existence of a frame-local face with name FACE on that frame.\n\
3179 Otherwise check for the existence of a global face.")
3181 Lisp_Object face
, frame
;
3187 CHECK_LIVE_FRAME (frame
, 1);
3188 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3191 lface
= lface_from_face_name (NULL
, face
, 0);
3197 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3198 Sinternal_copy_lisp_face
, 4, 4, 0,
3199 "Copy face FROM to TO.\n\
3200 If FRAME it t, copy the global face definition of FROM to the\n\
3201 global face definition of TO. Otherwise, copy the frame-local\n\
3202 definition of FROM on FRAME to the frame-local definition of TO\n\
3203 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3206 (from
, to
, frame
, new_frame
)
3207 Lisp_Object from
, to
, frame
, new_frame
;
3209 Lisp_Object lface
, copy
;
3211 CHECK_SYMBOL (from
, 0);
3212 CHECK_SYMBOL (to
, 1);
3213 if (NILP (new_frame
))
3218 /* Copy global definition of FROM. We don't make copies of
3219 strings etc. because 20.2 didn't do it either. */
3220 lface
= lface_from_face_name (NULL
, from
, 1);
3221 copy
= Finternal_make_lisp_face (to
, Qnil
);
3225 /* Copy frame-local definition of FROM. */
3226 CHECK_LIVE_FRAME (frame
, 2);
3227 CHECK_LIVE_FRAME (new_frame
, 3);
3228 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3229 copy
= Finternal_make_lisp_face (to
, new_frame
);
3232 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3233 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3239 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3240 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3241 "Set attribute ATTR of FACE to VALUE.\n\
3242 If optional argument FRAME is given, set the face attribute of face FACE\n\
3243 on that frame. If FRAME is t, set the attribute of the default for face\n\
3244 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3246 (face
, attr
, value
, frame
)
3247 Lisp_Object face
, attr
, value
, frame
;
3250 Lisp_Object old_value
= Qnil
;
3251 int font_related_attr_p
= 0;
3253 CHECK_SYMBOL (face
, 0);
3254 CHECK_SYMBOL (attr
, 1);
3256 face
= resolve_face_name (face
);
3258 /* Set lface to the Lisp attribute vector of FACE. */
3260 lface
= lface_from_face_name (NULL
, face
, 1);
3264 frame
= selected_frame
;
3266 CHECK_LIVE_FRAME (frame
, 3);
3267 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3269 /* If a frame-local face doesn't exist yet, create one. */
3271 lface
= Finternal_make_lisp_face (face
, frame
);
3274 if (EQ (attr
, QCfamily
))
3276 if (!UNSPECIFIEDP (value
))
3278 CHECK_STRING (value
, 3);
3279 if (XSTRING (value
)->size
== 0)
3280 signal_error ("Invalid face family", value
);
3282 old_value
= LFACE_FAMILY (lface
);
3283 LFACE_FAMILY (lface
) = value
;
3284 font_related_attr_p
= 1;
3286 else if (EQ (attr
, QCheight
))
3288 if (!UNSPECIFIEDP (value
))
3290 CHECK_NUMBER (value
, 3);
3291 if (XINT (value
) <= 0)
3292 signal_error ("Invalid face height", value
);
3294 old_value
= LFACE_HEIGHT (lface
);
3295 LFACE_HEIGHT (lface
) = value
;
3296 font_related_attr_p
= 1;
3298 else if (EQ (attr
, QCweight
))
3300 if (!UNSPECIFIEDP (value
))
3302 CHECK_SYMBOL (value
, 3);
3303 if (face_numeric_weight (value
) < 0)
3304 signal_error ("Invalid face weight", value
);
3306 old_value
= LFACE_WEIGHT (lface
);
3307 LFACE_WEIGHT (lface
) = value
;
3308 font_related_attr_p
= 1;
3310 else if (EQ (attr
, QCslant
))
3312 if (!UNSPECIFIEDP (value
))
3314 CHECK_SYMBOL (value
, 3);
3315 if (face_numeric_slant (value
) < 0)
3316 signal_error ("Invalid face slant", value
);
3318 old_value
= LFACE_SLANT (lface
);
3319 LFACE_SLANT (lface
) = value
;
3320 font_related_attr_p
= 1;
3322 else if (EQ (attr
, QCunderline
))
3324 if (!UNSPECIFIEDP (value
))
3325 if ((SYMBOLP (value
)
3327 && !EQ (value
, Qnil
))
3328 /* Underline color. */
3330 && XSTRING (value
)->size
== 0))
3331 signal_error ("Invalid face underline", value
);
3333 old_value
= LFACE_UNDERLINE (lface
);
3334 LFACE_UNDERLINE (lface
) = value
;
3336 else if (EQ (attr
, QCoverline
))
3338 if (!UNSPECIFIEDP (value
))
3339 if ((SYMBOLP (value
)
3341 && !EQ (value
, Qnil
))
3342 /* Overline color. */
3344 && XSTRING (value
)->size
== 0))
3345 signal_error ("Invalid face overline", value
);
3347 old_value
= LFACE_OVERLINE (lface
);
3348 LFACE_OVERLINE (lface
) = value
;
3350 else if (EQ (attr
, QCstrike_through
))
3352 if (!UNSPECIFIEDP (value
))
3353 if ((SYMBOLP (value
)
3355 && !EQ (value
, Qnil
))
3356 /* Strike-through color. */
3358 && XSTRING (value
)->size
== 0))
3359 signal_error ("Invalid face strike-through", value
);
3361 old_value
= LFACE_STRIKE_THROUGH (lface
);
3362 LFACE_STRIKE_THROUGH (lface
) = value
;
3364 else if (EQ (attr
, QCbox
))
3368 /* Allow t meaning a simple box of width 1 in foreground color
3371 value
= make_number (1);
3373 if (UNSPECIFIEDP (value
))
3375 else if (NILP (value
))
3377 else if (INTEGERP (value
))
3378 valid_p
= XINT (value
) > 0;
3379 else if (STRINGP (value
))
3380 valid_p
= XSTRING (value
)->size
> 0;
3381 else if (CONSP (value
))
3397 if (EQ (k
, QCline_width
))
3399 if (!INTEGERP (v
) || XINT (v
) <= 0)
3402 else if (EQ (k
, QCcolor
))
3404 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3407 else if (EQ (k
, QCstyle
))
3409 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3416 valid_p
= NILP (tem
);
3422 signal_error ("Invalid face box", value
);
3424 old_value
= LFACE_BOX (lface
);
3425 LFACE_BOX (lface
) = value
;
3427 else if (EQ (attr
, QCinverse_video
)
3428 || EQ (attr
, QCreverse_video
))
3430 if (!UNSPECIFIEDP (value
))
3432 CHECK_SYMBOL (value
, 3);
3433 if (!EQ (value
, Qt
) && !NILP (value
))
3434 signal_error ("Invalid inverse-video face attribute value", value
);
3436 old_value
= LFACE_INVERSE (lface
);
3437 LFACE_INVERSE (lface
) = value
;
3439 else if (EQ (attr
, QCforeground
))
3441 if (!UNSPECIFIEDP (value
)
3442 && !EQ (value
, Qunspecified_fg
) && !EQ (value
, Qunspecified_bg
))
3444 /* Don't check for valid color names here because it depends
3445 on the frame (display) whether the color will be valid
3446 when the face is realized. */
3447 CHECK_STRING (value
, 3);
3448 if (XSTRING (value
)->size
== 0)
3449 signal_error ("Empty foreground color value", value
);
3451 old_value
= LFACE_FOREGROUND (lface
);
3452 LFACE_FOREGROUND (lface
) = value
;
3454 else if (EQ (attr
, QCbackground
))
3456 if (!UNSPECIFIEDP (value
)
3457 && !EQ (value
, Qunspecified_bg
) && !EQ (value
, Qunspecified_fg
))
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 background color value", value
);
3466 old_value
= LFACE_BACKGROUND (lface
);
3467 LFACE_BACKGROUND (lface
) = value
;
3469 else if (EQ (attr
, QCstipple
))
3471 #ifdef HAVE_X_WINDOWS
3472 if (!UNSPECIFIEDP (value
)
3474 && NILP (Fbitmap_spec_p (value
)))
3475 signal_error ("Invalid stipple attribute", value
);
3476 old_value
= LFACE_STIPPLE (lface
);
3477 LFACE_STIPPLE (lface
) = value
;
3478 #endif /* HAVE_X_WINDOWS */
3480 else if (EQ (attr
, QCwidth
))
3482 if (!UNSPECIFIEDP (value
))
3484 CHECK_SYMBOL (value
, 3);
3485 if (face_numeric_swidth (value
) < 0)
3486 signal_error ("Invalid face width", value
);
3488 old_value
= LFACE_SWIDTH (lface
);
3489 LFACE_SWIDTH (lface
) = value
;
3490 font_related_attr_p
= 1;
3492 else if (EQ (attr
, QCfont
))
3494 #ifdef HAVE_X_WINDOWS
3495 /* Set font-related attributes of the Lisp face from an
3499 CHECK_STRING (value
, 3);
3501 f
= SELECTED_FRAME ();
3503 f
= check_x_frame (frame
);
3505 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3506 signal_error ("Invalid font name", value
);
3508 font_related_attr_p
= 1;
3509 #endif /* HAVE_X_WINDOWS */
3511 else if (EQ (attr
, QCbold
))
3513 old_value
= LFACE_WEIGHT (lface
);
3514 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3515 font_related_attr_p
= 1;
3517 else if (EQ (attr
, QCitalic
))
3519 old_value
= LFACE_SLANT (lface
);
3520 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3521 font_related_attr_p
= 1;
3524 signal_error ("Invalid face attribute name", attr
);
3526 /* Changing a named face means that all realized faces depending on
3527 that face are invalid. Since we cannot tell which realized faces
3528 depend on the face, make sure they are all removed. This is done
3529 by incrementing face_change_count. The next call to
3530 init_iterator will then free realized faces. */
3532 && (EQ (attr
, QCfont
)
3533 || NILP (Fequal (old_value
, value
))))
3535 ++face_change_count
;
3536 ++windows_or_buffers_changed
;
3539 #ifdef HAVE_X_WINDOWS
3542 && !UNSPECIFIEDP (value
)
3543 && NILP (Fequal (old_value
, value
)))
3549 if (EQ (face
, Qdefault
))
3551 /* Changed font-related attributes of the `default' face are
3552 reflected in changed `font' frame parameters. */
3553 if (font_related_attr_p
3554 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3555 set_font_frame_param (frame
, lface
);
3556 else if (EQ (attr
, QCforeground
))
3557 param
= Qforeground_color
;
3558 else if (EQ (attr
, QCbackground
))
3559 param
= Qbackground_color
;
3561 else if (EQ (face
, Qscroll_bar
))
3563 /* Changing the colors of `scroll-bar' sets frame parameters
3564 `scroll-bar-foreground' and `scroll-bar-background'. */
3565 if (EQ (attr
, QCforeground
))
3566 param
= Qscroll_bar_foreground
;
3567 else if (EQ (attr
, QCbackground
))
3568 param
= Qscroll_bar_background
;
3570 else if (EQ (face
, Qborder
))
3572 /* Changing background color of `border' sets frame parameter
3574 if (EQ (attr
, QCbackground
))
3575 param
= Qborder_color
;
3577 else if (EQ (face
, Qcursor
))
3579 /* Changing background color of `cursor' sets frame parameter
3581 if (EQ (attr
, QCbackground
))
3582 param
= Qcursor_color
;
3584 else if (EQ (face
, Qmouse
))
3586 /* Changing background color of `mouse' sets frame parameter
3588 if (EQ (attr
, QCbackground
))
3589 param
= Qmouse_color
;
3592 if (SYMBOLP (param
))
3593 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3596 #endif /* HAVE_X_WINDOWS */
3602 #ifdef HAVE_X_WINDOWS
3604 /* Set the `font' frame parameter of FRAME according to `default' face
3605 attributes LFACE. */
3608 set_font_frame_param (frame
, lface
)
3609 Lisp_Object frame
, lface
;
3611 struct frame
*f
= XFRAME (frame
);
3612 Lisp_Object frame_font
;
3616 /* Get FRAME's font parameter. */
3617 frame_font
= Fassq (Qfont
, f
->param_alist
);
3618 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3619 frame_font
= XCDR (frame_font
);
3621 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3624 /* Frame parameter is a fontset name. Modify the fontset so
3625 that all its fonts reflect face attributes LFACE. */
3627 struct fontset_info
*fontset_info
;
3629 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3631 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3632 if (fontset_info
->fontname
[charset
])
3634 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3636 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3637 build_string (font
), frame
);
3643 /* Frame parameter is an X font name. I believe this can
3644 only happen in unibyte mode. */
3645 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3646 -1, Vface_default_registry
);
3649 store_frame_param (f
, Qfont
, build_string (font
));
3656 /* Update the corresponding face when frame parameter PARAM on frame F
3657 has been assigned the value NEW_VALUE. */
3660 update_face_from_frame_parameter (f
, param
, new_value
)
3662 Lisp_Object param
, new_value
;
3666 /* If there are no faces yet, give up. This is the case when called
3667 from Fx_create_frame, and we do the necessary things later in
3668 face-set-after-frame-defaults. */
3669 if (NILP (f
->face_alist
))
3672 if (EQ (param
, Qforeground_color
))
3674 lface
= lface_from_face_name (f
, Qdefault
, 1);
3675 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3676 ? new_value
: Qunspecified
);
3677 realize_basic_faces (f
);
3679 else if (EQ (param
, Qbackground_color
))
3683 /* Changing the background color might change the background
3684 mode, so that we have to load new defface specs. Call
3685 frame-update-face-colors to do that. */
3686 XSETFRAME (frame
, f
);
3687 call1 (Qframe_update_face_colors
, frame
);
3689 lface
= lface_from_face_name (f
, Qdefault
, 1);
3690 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3691 ? new_value
: Qunspecified
);
3692 realize_basic_faces (f
);
3694 if (EQ (param
, Qborder_color
))
3696 lface
= lface_from_face_name (f
, Qborder
, 1);
3697 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3698 ? new_value
: Qunspecified
);
3700 else if (EQ (param
, Qcursor_color
))
3702 lface
= lface_from_face_name (f
, Qcursor
, 1);
3703 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3704 ? new_value
: Qunspecified
);
3706 else if (EQ (param
, Qmouse_color
))
3708 lface
= lface_from_face_name (f
, Qmouse
, 1);
3709 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3710 ? new_value
: Qunspecified
);
3715 /* Get the value of X resource RESOURCE, class CLASS for the display
3716 of frame FRAME. This is here because ordinary `x-get-resource'
3717 doesn't take a frame argument. */
3719 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3720 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3721 (resource
, class, frame
)
3722 Lisp_Object resource
, class, frame
;
3725 CHECK_STRING (resource
, 0);
3726 CHECK_STRING (class, 1);
3727 CHECK_LIVE_FRAME (frame
, 2);
3729 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3730 resource
, class, Qnil
, Qnil
);
3736 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3737 If VALUE is "on" or "true", return t. If VALUE is "off" or
3738 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3739 error; if SIGNAL_P is zero, return 0. */
3742 face_boolean_x_resource_value (value
, signal_p
)
3746 Lisp_Object result
= make_number (0);
3748 xassert (STRINGP (value
));
3750 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3751 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3753 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3754 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3756 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3757 result
= Qunspecified
;
3759 signal_error ("Invalid face attribute value from X resource", value
);
3765 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3766 Finternal_set_lisp_face_attribute_from_resource
,
3767 Sinternal_set_lisp_face_attribute_from_resource
,
3769 (face
, attr
, value
, frame
)
3770 Lisp_Object face
, attr
, value
, frame
;
3772 CHECK_SYMBOL (face
, 0);
3773 CHECK_SYMBOL (attr
, 1);
3774 CHECK_STRING (value
, 2);
3776 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3777 value
= Qunspecified
;
3778 else if (EQ (attr
, QCheight
))
3780 value
= Fstring_to_number (value
, make_number (10));
3781 if (XINT (value
) <= 0)
3782 signal_error ("Invalid face height from X resource", value
);
3784 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3785 value
= face_boolean_x_resource_value (value
, 1);
3786 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3787 value
= intern (XSTRING (value
)->data
);
3788 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3789 value
= face_boolean_x_resource_value (value
, 1);
3790 else if (EQ (attr
, QCunderline
)
3791 || EQ (attr
, QCoverline
)
3792 || EQ (attr
, QCstrike_through
)
3793 || EQ (attr
, QCbox
))
3795 Lisp_Object boolean_value
;
3797 /* If the result of face_boolean_x_resource_value is t or nil,
3798 VALUE does NOT specify a color. */
3799 boolean_value
= face_boolean_x_resource_value (value
, 0);
3800 if (SYMBOLP (boolean_value
))
3801 value
= boolean_value
;
3804 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3809 /***********************************************************************
3811 ***********************************************************************/
3813 #ifdef USE_X_TOOLKIT
3815 /* Structure used to pass X resources to functions called via
3816 XtApplyToWidgets. */
3827 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3828 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3831 /* Set widget W's X resources from P which points to an x_resources
3832 structure. If W is a cascade button, apply resources to W's
3836 xm_apply_resources (w
, p
)
3841 struct x_resources
*res
= (struct x_resources
*) p
;
3843 XtSetValues (w
, res
->av
, res
->ac
);
3844 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3847 XtSetValues (submenu
, res
->av
, res
->ac
);
3848 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3853 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3854 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3857 1. Setting the XmNfontList resource leads to an infinite loop
3858 somewhere in LessTif. */
3861 xm_set_menu_resources_from_menu_face (f
, widget
)
3871 lface
= lface_from_face_name (f
, Qmenu
, 1);
3872 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3874 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3876 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3880 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3882 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3886 /* If any font-related attribute of `menu' is set, set the font. */
3888 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3889 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3890 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3891 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3892 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3894 #if 0 /* Setting the font leads to an infinite loop somewhere
3895 in LessTif during geometry computation. */
3897 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3898 fl
= XmFontListAppendEntry (NULL
, fe
);
3899 XtSetArg (av
[ac
], XmNfontList
, fl
);
3904 xassert (ac
<= sizeof av
/ sizeof *av
);
3908 struct x_resources res
;
3910 XtSetValues (widget
, av
, ac
);
3911 res
.av
= av
, res
.ac
= ac
;
3912 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3914 XmFontListFree (fl
);
3919 #endif /* USE_MOTIF */
3923 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3924 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3927 /* Set widget W's resources from P which points to an x_resources
3931 xl_apply_resources (widget
, p
)
3935 struct x_resources
*res
= (struct x_resources
*) p
;
3936 XtSetValues (widget
, res
->av
, res
->ac
);
3940 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3941 This is the Lucid version. */
3944 xl_set_menu_resources_from_menu_face (f
, widget
)
3953 lface
= lface_from_face_name (f
, Qmenu
, 1);
3954 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3956 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3958 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3962 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3964 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3969 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3970 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3971 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3972 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3973 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3975 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3981 struct x_resources res
;
3983 XtSetValues (widget
, av
, ac
);
3985 /* We must do children here in case we're handling a pop-up menu
3986 in which case WIDGET is a popup shell. XtApplyToWidgets
3987 is a function from lwlib. */
3988 res
.av
= av
, res
.ac
= ac
;
3989 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
3993 #endif /* USE_LUCID */
3996 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
3999 x_set_menu_resources_from_menu_face (f
, widget
)
4003 /* Realized faces may have been removed on frame F, e.g. because of
4004 face attribute changes. Recompute them, if necessary, since we
4005 will need the `menu' face. */
4006 if (f
->face_cache
->used
== 0)
4007 recompute_basic_faces (f
);
4010 xl_set_menu_resources_from_menu_face (f
, widget
);
4013 xm_set_menu_resources_from_menu_face (f
, widget
);
4017 #endif /* USE_X_TOOLKIT */
4019 #endif /* HAVE_X_WINDOWS */
4023 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4024 Sinternal_get_lisp_face_attribute
,
4026 "Return face attribute KEYWORD of face SYMBOL.\n\
4027 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4028 face attribute name, signal an error.\n\
4029 If the optional argument FRAME is given, report on face FACE in that\n\
4030 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4031 frames). If FRAME is omitted or nil, use the selected frame.")
4032 (symbol
, keyword
, frame
)
4033 Lisp_Object symbol
, keyword
, frame
;
4035 Lisp_Object lface
, value
= Qnil
;
4037 CHECK_SYMBOL (symbol
, 0);
4038 CHECK_SYMBOL (keyword
, 1);
4041 lface
= lface_from_face_name (NULL
, symbol
, 1);
4045 frame
= selected_frame
;
4046 CHECK_LIVE_FRAME (frame
, 2);
4047 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4050 if (EQ (keyword
, QCfamily
))
4051 value
= LFACE_FAMILY (lface
);
4052 else if (EQ (keyword
, QCheight
))
4053 value
= LFACE_HEIGHT (lface
);
4054 else if (EQ (keyword
, QCweight
))
4055 value
= LFACE_WEIGHT (lface
);
4056 else if (EQ (keyword
, QCslant
))
4057 value
= LFACE_SLANT (lface
);
4058 else if (EQ (keyword
, QCunderline
))
4059 value
= LFACE_UNDERLINE (lface
);
4060 else if (EQ (keyword
, QCoverline
))
4061 value
= LFACE_OVERLINE (lface
);
4062 else if (EQ (keyword
, QCstrike_through
))
4063 value
= LFACE_STRIKE_THROUGH (lface
);
4064 else if (EQ (keyword
, QCbox
))
4065 value
= LFACE_BOX (lface
);
4066 else if (EQ (keyword
, QCinverse_video
)
4067 || EQ (keyword
, QCreverse_video
))
4068 value
= LFACE_INVERSE (lface
);
4069 else if (EQ (keyword
, QCforeground
))
4070 value
= LFACE_FOREGROUND (lface
);
4071 else if (EQ (keyword
, QCbackground
))
4072 value
= LFACE_BACKGROUND (lface
);
4073 else if (EQ (keyword
, QCstipple
))
4074 value
= LFACE_STIPPLE (lface
);
4075 else if (EQ (keyword
, QCwidth
))
4076 value
= LFACE_SWIDTH (lface
);
4078 signal_error ("Invalid face attribute name", keyword
);
4084 DEFUN ("internal-lisp-face-attribute-values",
4085 Finternal_lisp_face_attribute_values
,
4086 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4087 "Return a list of valid discrete values for face attribute ATTR.\n\
4088 Value is nil if ATTR doesn't have a discrete set of valid values.")
4092 Lisp_Object result
= Qnil
;
4094 CHECK_SYMBOL (attr
, 0);
4096 if (EQ (attr
, QCweight
)
4097 || EQ (attr
, QCslant
)
4098 || EQ (attr
, QCwidth
))
4100 /* Extract permissible symbols from tables. */
4101 struct table_entry
*table
;
4104 if (EQ (attr
, QCweight
))
4105 table
= weight_table
, dim
= DIM (weight_table
);
4106 else if (EQ (attr
, QCslant
))
4107 table
= slant_table
, dim
= DIM (slant_table
);
4109 table
= swidth_table
, dim
= DIM (swidth_table
);
4111 for (i
= 0; i
< dim
; ++i
)
4113 Lisp_Object symbol
= *table
[i
].symbol
;
4114 Lisp_Object tail
= result
;
4117 && !EQ (XCAR (tail
), symbol
))
4121 result
= Fcons (symbol
, result
);
4124 else if (EQ (attr
, QCunderline
))
4125 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4126 else if (EQ (attr
, QCoverline
))
4127 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4128 else if (EQ (attr
, QCstrike_through
))
4129 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4130 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4131 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4137 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4138 Sinternal_merge_in_global_face
, 2, 2, 0,
4139 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4141 Lisp_Object face
, frame
;
4143 Lisp_Object global_lface
, local_lface
;
4144 CHECK_LIVE_FRAME (frame
, 1);
4145 global_lface
= lface_from_face_name (NULL
, face
, 1);
4146 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4147 if (NILP (local_lface
))
4148 local_lface
= Finternal_make_lisp_face (face
, frame
);
4149 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4150 XVECTOR (local_lface
)->contents
);
4155 /* The following function is implemented for compatibility with 20.2.
4156 The function is used in x-resolve-fonts when it is asked to
4157 return fonts with the same size as the font of a face. This is
4158 done in fontset.el. */
4160 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4161 "Return the font name of face FACE, or nil if it is unspecified.\n\
4162 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4163 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4164 The font default for a face is either nil, or a list\n\
4165 of the form (bold), (italic) or (bold italic).\n\
4166 If FRAME is omitted or nil, use the selected frame.")
4168 Lisp_Object face
, frame
;
4172 Lisp_Object result
= Qnil
;
4173 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4175 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4176 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4177 result
= Fcons (Qbold
, result
);
4179 if (!NILP (LFACE_SLANT (lface
))
4180 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4181 result
= Fcons (Qitalic
, result
);
4187 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4188 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4189 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4190 return build_string (face
->font_name
);
4195 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4196 all attributes are `equal'. Tries to be fast because this function
4197 is called quite often. */
4200 lface_equal_p (v1
, v2
)
4201 Lisp_Object
*v1
, *v2
;
4205 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4207 Lisp_Object a
= v1
[i
];
4208 Lisp_Object b
= v2
[i
];
4210 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4211 and the other is specified. */
4212 equal_p
= XTYPE (a
) == XTYPE (b
);
4221 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4222 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4223 XSTRING (a
)->size
) == 0);
4232 equal_p
= !NILP (Fequal (a
, b
));
4242 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4243 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4244 "True if FACE1 and FACE2 are equal.\n\
4245 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4246 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4247 If FRAME is omitted or nil, use the selected frame.")
4248 (face1
, face2
, frame
)
4249 Lisp_Object face1
, face2
, frame
;
4253 Lisp_Object lface1
, lface2
;
4258 /* Don't use check_x_frame here because this function is called
4259 before X frames exist. At that time, if FRAME is nil,
4260 selected_frame will be used which is the frame dumped with
4261 Emacs. That frame is not an X frame. */
4262 f
= frame_or_selected_frame (frame
, 2);
4264 lface1
= lface_from_face_name (NULL
, face1
, 1);
4265 lface2
= lface_from_face_name (NULL
, face2
, 1);
4266 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4267 XVECTOR (lface2
)->contents
);
4268 return equal_p
? Qt
: Qnil
;
4272 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4273 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4274 "True if FACE has no attribute specified.\n\
4275 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4276 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4277 If FRAME is omitted or nil, use the selected frame.")
4279 Lisp_Object face
, frame
;
4286 frame
= selected_frame
;
4287 CHECK_LIVE_FRAME (frame
, 0);
4291 lface
= lface_from_face_name (NULL
, face
, 1);
4293 lface
= lface_from_face_name (f
, face
, 1);
4295 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4296 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4299 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4303 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4305 "Return an alist of frame-local faces defined on FRAME.\n\
4306 For internal use only.")
4310 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4311 return f
->face_alist
;
4315 /* Return a hash code for Lisp string STRING with case ignored. Used
4316 below in computing a hash value for a Lisp face. */
4318 static INLINE
unsigned
4319 hash_string_case_insensitive (string
)
4324 xassert (STRINGP (string
));
4325 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4326 hash
= (hash
<< 1) ^ tolower (*s
);
4331 /* Return a hash code for face attribute vector V. */
4333 static INLINE
unsigned
4337 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4338 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4339 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4340 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4341 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4342 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4343 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4347 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4348 considering charsets/registries). They do if they specify the same
4349 family, point size, weight, width and slant. Both LFACE1 and
4350 LFACE2 must be fully-specified. */
4353 lface_same_font_attributes_p (lface1
, lface2
)
4354 Lisp_Object
*lface1
, *lface2
;
4356 xassert (lface_fully_specified_p (lface1
)
4357 && lface_fully_specified_p (lface2
));
4358 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4359 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4360 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4361 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4362 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4363 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4364 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4369 /***********************************************************************
4371 ***********************************************************************/
4373 /* Allocate and return a new realized face for Lisp face attribute
4374 vector ATTR, charset CHARSET, and registry REGISTRY. */
4376 static struct face
*
4377 make_realized_face (attr
, charset
, registry
)
4380 Lisp_Object registry
;
4382 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4383 bzero (face
, sizeof *face
);
4384 face
->charset
= charset
;
4385 face
->registry
= registry
;
4386 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4391 /* Free realized face FACE, including its X resources. FACE may
4395 free_realized_face (f
, face
)
4401 #ifdef HAVE_X_WINDOWS
4406 x_free_gc (f
, face
->gc
);
4410 free_face_colors (f
, face
);
4411 x_destroy_bitmap (f
, face
->stipple
);
4413 #endif /* HAVE_X_WINDOWS */
4420 /* Prepare face FACE for subsequent display on frame F. This
4421 allocated GCs if they haven't been allocated yet or have been freed
4422 by clearing the face cache. */
4425 prepare_face_for_display (f
, face
)
4429 #ifdef HAVE_X_WINDOWS
4430 xassert (FRAME_X_P (f
));
4435 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4437 xgcv
.foreground
= face
->foreground
;
4438 xgcv
.background
= face
->background
;
4439 xgcv
.graphics_exposures
= False
;
4441 /* The font of FACE may be null if we couldn't load it. */
4444 xgcv
.font
= face
->font
->fid
;
4451 xgcv
.fill_style
= FillOpaqueStippled
;
4452 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4453 mask
|= GCFillStyle
| GCStipple
;
4456 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4463 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4464 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4465 ISO8859-1 if the ASCII face suffices. */
4468 face_suitable_for_iso8859_1_p (face
)
4471 int len
= strlen (face
->font_name
);
4472 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4476 /* Value is non-zero if FACE is suitable for displaying characters
4477 of CHARSET. CHARSET < 0 means unibyte text. */
4480 face_suitable_for_charset_p (face
, charset
)
4488 if (EQ (face
->registry
, Vface_default_registry
)
4489 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4492 else if (face
->charset
== charset
)
4494 else if (face
->charset
== CHARSET_ASCII
4495 && charset
== charset_latin_iso8859_1
)
4496 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4497 else if (face
->charset
== charset_latin_iso8859_1
4498 && charset
== CHARSET_ASCII
)
4506 /***********************************************************************
4508 ***********************************************************************/
4510 /* Return a new face cache for frame F. */
4512 static struct face_cache
*
4516 struct face_cache
*c
;
4519 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4520 bzero (c
, sizeof *c
);
4521 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4522 c
->buckets
= (struct face
**) xmalloc (size
);
4523 bzero (c
->buckets
, size
);
4525 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4531 /* Clear out all graphics contexts for all realized faces, except for
4532 the basic faces. This should be done from time to time just to avoid
4533 keeping too many graphics contexts that are no longer needed. */
4537 struct face_cache
*c
;
4539 if (c
&& FRAME_X_P (c
->f
))
4541 #ifdef HAVE_X_WINDOWS
4543 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4545 struct face
*face
= c
->faces_by_id
[i
];
4546 if (face
&& face
->gc
)
4548 x_free_gc (c
->f
, face
->gc
);
4552 #endif /* HAVE_X_WINDOWS */
4557 /* Free all realized faces in face cache C, including basic faces. C
4558 may be null. If faces are freed, make sure the frame's current
4559 matrix is marked invalid, so that a display caused by an expose
4560 event doesn't try to use faces we destroyed. */
4563 free_realized_faces (c
)
4564 struct face_cache
*c
;
4569 struct frame
*f
= c
->f
;
4571 for (i
= 0; i
< c
->used
; ++i
)
4573 free_realized_face (f
, c
->faces_by_id
[i
]);
4574 c
->faces_by_id
[i
] = NULL
;
4578 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4579 bzero (c
->buckets
, size
);
4581 /* Must do a thorough redisplay the next time. Mark current
4582 matrices as invalid because they will reference faces freed
4583 above. This function is also called when a frame is
4584 destroyed. In this case, the root window of F is nil. */
4585 if (WINDOWP (f
->root_window
))
4587 clear_current_matrices (f
);
4588 ++windows_or_buffers_changed
;
4594 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4595 This is done after attributes of a named face have been changed,
4596 because we can't tell which realized faces depend on that face. */
4599 free_all_realized_faces (frame
)
4605 FOR_EACH_FRAME (rest
, frame
)
4606 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4609 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4613 /* Free face cache C and faces in it, including their X resources. */
4617 struct face_cache
*c
;
4621 free_realized_faces (c
);
4623 xfree (c
->faces_by_id
);
4629 /* Cache realized face FACE in face cache C. HASH is the hash value
4630 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4631 collision list of the face hash table of C. This is done because
4632 otherwise lookup_face would find FACE for every charset, even if
4633 faces with the same attributes but for specific charsets exist. */
4636 cache_face (c
, face
, hash
)
4637 struct face_cache
*c
;
4641 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4645 if (face
->fontset
>= 0)
4647 struct face
*last
= c
->buckets
[i
];
4658 c
->buckets
[i
] = face
;
4659 face
->prev
= face
->next
= NULL
;
4665 face
->next
= c
->buckets
[i
];
4667 face
->next
->prev
= face
;
4668 c
->buckets
[i
] = face
;
4671 /* Find a free slot in C->faces_by_id and use the index of the free
4672 slot as FACE->id. */
4673 for (i
= 0; i
< c
->used
; ++i
)
4674 if (c
->faces_by_id
[i
] == NULL
)
4678 /* Maybe enlarge C->faces_by_id. */
4679 if (i
== c
->used
&& c
->used
== c
->size
)
4681 int new_size
= 2 * c
->size
;
4682 int sz
= new_size
* sizeof *c
->faces_by_id
;
4683 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4688 /* Check that FACE got a unique id. */
4693 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4694 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4700 #endif /* GLYPH_DEBUG */
4702 c
->faces_by_id
[i
] = face
;
4708 /* Remove face FACE from cache C. */
4711 uncache_face (c
, face
)
4712 struct face_cache
*c
;
4715 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4718 face
->prev
->next
= face
->next
;
4720 c
->buckets
[i
] = face
->next
;
4723 face
->next
->prev
= face
->prev
;
4725 c
->faces_by_id
[face
->id
] = NULL
;
4726 if (face
->id
== c
->used
)
4731 /* Look up a realized face with face attributes ATTR in the face cache
4732 of frame F. The face will be used to display characters of
4733 CHARSET. CHARSET < 0 means the face will be used to display
4734 unibyte text. The value of face-default-registry is used to choose
4735 a font for the face in that case. Value is the ID of the face
4736 found. If no suitable face is found, realize a new one. */
4739 lookup_face (f
, attr
, charset
)
4744 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4749 xassert (c
!= NULL
);
4750 check_lface_attrs (attr
);
4752 /* Look up ATTR in the face cache. */
4753 hash
= lface_hash (attr
);
4754 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4756 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4757 if (face
->hash
== hash
4758 && (!FRAME_WINDOW_P (f
)
4759 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4760 && lface_equal_p (face
->lface
, attr
))
4763 /* If not found, realize a new face. */
4766 face
= realize_face (c
, attr
, charset
);
4767 cache_face (c
, face
, hash
);
4771 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4773 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4774 #endif /* GLYPH_DEBUG */
4780 /* Return the face id of the realized face for named face SYMBOL on
4781 frame F suitable for displaying characters from CHARSET. CHARSET <
4782 0 means unibyte text. */
4785 lookup_named_face (f
, symbol
, charset
)
4790 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4791 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4792 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4794 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4795 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4796 merge_face_vectors (symbol_attrs
, attrs
);
4797 return lookup_face (f
, attrs
, charset
);
4801 /* Return the ID of the realized ASCII face of Lisp face with ID
4802 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4805 ascii_face_of_lisp_face (f
, lface_id
)
4811 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4813 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4814 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4823 /* Return a face for charset ASCII that is like the face with id
4824 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4825 STEPS < 0 means larger. Value is the id of the face. */
4828 smaller_face (f
, face_id
, steps
)
4832 #ifdef HAVE_X_WINDOWS
4834 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4835 int pt
, last_pt
, last_height
;
4838 struct face
*new_face
;
4840 /* If not called for an X frame, just return the original face. */
4841 if (FRAME_TERMCAP_P (f
))
4844 /* Try in increments of 1/2 pt. */
4845 delta
= steps
< 0 ? 5 : -5;
4846 steps
= abs (steps
);
4848 face
= FACE_FROM_ID (f
, face_id
);
4849 bcopy (face
->lface
, attrs
, sizeof attrs
);
4850 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4851 new_face_id
= face_id
;
4852 last_height
= FONT_HEIGHT (face
->font
);
4856 /* Give up if we cannot find a font within 10pt. */
4857 && abs (last_pt
- pt
) < 100)
4859 /* Look up a face for a slightly smaller/larger font. */
4861 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4862 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4863 new_face
= FACE_FROM_ID (f
, new_face_id
);
4865 /* If height changes, count that as one step. */
4866 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4869 last_height
= FONT_HEIGHT (new_face
->font
);
4876 #else /* not HAVE_X_WINDOWS */
4880 #endif /* not HAVE_X_WINDOWS */
4884 /* Return a face for charset ASCII that is like the face with id
4885 FACE_ID on frame F, but has height HEIGHT. */
4888 face_with_height (f
, face_id
, height
)
4893 #ifdef HAVE_X_WINDOWS
4895 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4897 if (FRAME_TERMCAP_P (f
)
4901 face
= FACE_FROM_ID (f
, face_id
);
4902 bcopy (face
->lface
, attrs
, sizeof attrs
);
4903 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4904 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4905 #endif /* HAVE_X_WINDOWS */
4910 /* Return the face id of the realized face for named face SYMBOL on
4911 frame F suitable for displaying characters from CHARSET (CHARSET <
4912 0 means unibyte text), and use attributes of the face FACE_ID for
4913 attributes that aren't completely specified by SYMBOL. This is
4914 like lookup_named_face, except that the default attributes come
4915 from FACE_ID, not from the default face. FACE_ID is assumed to
4916 be already realized. */
4919 lookup_derived_face (f
, symbol
, charset
, face_id
)
4925 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4926 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4927 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4932 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4933 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4934 merge_face_vectors (symbol_attrs
, attrs
);
4935 return lookup_face (f
, attrs
, charset
);
4940 /***********************************************************************
4942 ***********************************************************************/
4944 DEFUN ("internal-set-font-selection-order",
4945 Finternal_set_font_selection_order
,
4946 Sinternal_set_font_selection_order
, 1, 1, 0,
4947 "Set font selection order for face font selection to ORDER.\n\
4948 ORDER must be a list of length 4 containing the symbols `:width',\n\
4949 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4950 first in ORDER are matched first, e.g. if `:height' appears before\n\
4951 `:weight' in ORDER, font selection first tries to find a font with\n\
4952 a suitable height, and then tries to match the font weight.\n\
4961 CHECK_LIST (order
, 0);
4962 bzero (indices
, sizeof indices
);
4966 CONSP (list
) && i
< DIM (indices
);
4967 list
= XCDR (list
), ++i
)
4969 Lisp_Object attr
= XCAR (list
);
4972 if (EQ (attr
, QCwidth
))
4974 else if (EQ (attr
, QCheight
))
4975 xlfd
= XLFD_POINT_SIZE
;
4976 else if (EQ (attr
, QCweight
))
4978 else if (EQ (attr
, QCslant
))
4983 if (indices
[i
] != 0)
4989 || i
!= DIM (indices
)
4994 signal_error ("Invalid font sort order", order
);
4996 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4998 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4999 free_all_realized_faces (Qnil
);
5006 DEFUN ("internal-set-alternative-font-family-alist",
5007 Finternal_set_alternative_font_family_alist
,
5008 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5009 "Define alternative font families to try in face font selection.\n\
5010 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5011 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5012 be found. Value is ALIST.")
5016 CHECK_LIST (alist
, 0);
5017 Vface_alternative_font_family_alist
= alist
;
5018 free_all_realized_faces (Qnil
);
5023 #ifdef HAVE_X_WINDOWS
5025 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5026 Value is nil if not successful. */
5029 deduce_unibyte_registry (f
, font_name
)
5033 struct font_name font
;
5034 Lisp_Object registry
= Qnil
;
5036 font
.name
= STRDUPA (font_name
);
5037 if (split_font_name (f
, &font
, 0))
5041 /* Extract registry and encoding. */
5042 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5043 + strlen (font
.fields
[XLFD_ENCODING
])
5045 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5046 strcat (buffer
, "-");
5047 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5048 registry
= build_string (buffer
);
5055 /* Value is non-zero if FONT is the name of a scalable font. The
5056 X11R6 XLFD spec says that point size, pixel size, and average width
5057 are zero for scalable fonts. Intlfonts contain at least one
5058 scalable font ("*-muleindian-1") for which this isn't true, so we
5059 just test average width. */
5062 font_scalable_p (font
)
5063 struct font_name
*font
;
5065 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5066 return *s
== '0' && *(s
+ 1) == '\0';
5070 /* Value is non-zero if FONT1 is a better match for font attributes
5071 VALUES than FONT2. VALUES is an array of face attribute values in
5072 font sort order. COMPARE_PT_P zero means don't compare point
5076 better_font_p (values
, font1
, font2
, compare_pt_p
)
5078 struct font_name
*font1
, *font2
;
5083 for (i
= 0; i
< 4; ++i
)
5085 int xlfd_idx
= font_sort_order
[i
];
5087 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5089 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5090 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5092 if (delta1
> delta2
)
5094 else if (delta1
< delta2
)
5098 /* The difference may be equal because, e.g., the face
5099 specifies `italic' but we have only `regular' and
5100 `oblique'. Prefer `oblique' in this case. */
5101 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5102 && font1
->numeric
[xlfd_idx
] > values
[i
]
5103 && font2
->numeric
[xlfd_idx
] < values
[i
])
5115 /* Value is non-zero if FONT is an exact match for face attributes in
5116 SPECIFIED. SPECIFIED is an array of face attribute values in font
5120 exact_face_match_p (specified
, font
)
5122 struct font_name
*font
;
5126 for (i
= 0; i
< 4; ++i
)
5127 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5134 /* Value is the name of a scaled font, generated from scalable font
5135 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5136 Value is allocated from heap. */
5139 build_scalable_font_name (f
, font
, specified_pt
)
5141 struct font_name
*font
;
5144 char point_size
[20], pixel_size
[20];
5146 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5149 /* If scalable font is for a specific resolution, compute
5150 the point size we must specify from the resolution of
5151 the display and the specified resolution of the font. */
5152 if (font
->numeric
[XLFD_RESY
] != 0)
5154 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5155 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5160 pixel_value
= resy
/ 720.0 * pt
;
5163 /* Set point size of the font. */
5164 sprintf (point_size
, "%d", (int) pt
);
5165 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5166 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5168 /* Set pixel size. */
5169 sprintf (pixel_size
, "%d", pixel_value
);
5170 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5171 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5173 /* If font doesn't specify its resolution, use the
5174 resolution of the display. */
5175 if (font
->numeric
[XLFD_RESY
] == 0)
5178 sprintf (buffer
, "%d", (int) resy
);
5179 font
->fields
[XLFD_RESY
] = buffer
;
5180 font
->numeric
[XLFD_RESY
] = resy
;
5183 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5186 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5187 sprintf (buffer
, "%d", resx
);
5188 font
->fields
[XLFD_RESX
] = buffer
;
5189 font
->numeric
[XLFD_RESX
] = resx
;
5192 return build_font_name (font
);
5196 /* Value is non-zero if we are allowed to use scalable font FONT. We
5197 can't run a Lisp function here since this function may be called
5198 with input blocked. */
5201 may_use_scalable_font_p (font
, name
)
5202 struct font_name
*font
;
5205 if (EQ (Vscalable_fonts_allowed
, Qt
))
5207 else if (CONSP (Vscalable_fonts_allowed
))
5209 Lisp_Object tail
, regexp
;
5211 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5213 regexp
= XCAR (tail
);
5214 if (STRINGP (regexp
)
5215 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5223 #endif /* SCALABLE_FONTS != 0 */
5226 /* Return the name of the best matching font for face attributes
5227 ATTRS in the array of font_name structures FONTS which contains
5228 NFONTS elements. Value is a font name which is allocated from
5229 the heap. FONTS is freed by this function. */
5232 best_matching_font (f
, attrs
, fonts
, nfonts
)
5235 struct font_name
*fonts
;
5239 struct font_name
*best
;
5247 /* Make specified font attributes available in `specified',
5248 indexed by sort order. */
5249 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5251 int xlfd_idx
= font_sort_order
[i
];
5253 if (xlfd_idx
== XLFD_SWIDTH
)
5254 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5255 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5256 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5257 else if (xlfd_idx
== XLFD_WEIGHT
)
5258 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5259 else if (xlfd_idx
== XLFD_SLANT
)
5260 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5270 /* Start with the first non-scalable font in the list. */
5271 for (i
= 0; i
< nfonts
; ++i
)
5272 if (!font_scalable_p (fonts
+ i
))
5275 /* Find the best match among the non-scalable fonts. */
5280 for (i
= 1; i
< nfonts
; ++i
)
5281 if (!font_scalable_p (fonts
+ i
)
5282 && better_font_p (specified
, fonts
+ i
, best
, 1))
5286 exact_p
= exact_face_match_p (specified
, best
);
5295 /* Unless we found an exact match among non-scalable fonts, see if
5296 we can find a better match among scalable fonts. */
5299 /* A scalable font is better if
5301 1. its weight, slant, swidth attributes are better, or.
5303 2. the best non-scalable font doesn't have the required
5304 point size, and the scalable fonts weight, slant, swidth
5307 int non_scalable_has_exact_height_p
;
5309 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5310 non_scalable_has_exact_height_p
= 1;
5312 non_scalable_has_exact_height_p
= 0;
5314 for (i
= 0; i
< nfonts
; ++i
)
5315 if (font_scalable_p (fonts
+ i
))
5318 || better_font_p (specified
, fonts
+ i
, best
, 0)
5319 || (!non_scalable_has_exact_height_p
5320 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5325 if (font_scalable_p (best
))
5326 font_name
= build_scalable_font_name (f
, best
, pt
);
5328 font_name
= build_font_name (best
);
5330 #else /* !SCALABLE_FONTS */
5332 /* Find the best non-scalable font. */
5335 for (i
= 1; i
< nfonts
; ++i
)
5337 xassert (!font_scalable_p (fonts
+ i
));
5338 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5342 font_name
= build_font_name (best
);
5344 #endif /* !SCALABLE_FONTS */
5346 /* Free font_name structures. */
5347 free_font_names (fonts
, nfonts
);
5353 /* Try to get a list of fonts on frame F with font family FAMILY and
5354 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5355 of font_name structures for the fonts matched. Value is the number
5359 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5362 char *pattern
, *family
, *registry
;
5363 struct font_name
**fonts
;
5368 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5370 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5376 /* Try alternative font families from
5377 Vface_alternative_font_family_alist. */
5378 alter
= Fassoc (build_string (family
),
5379 Vface_alternative_font_family_alist
);
5381 for (alter
= XCDR (alter
);
5382 CONSP (alter
) && nfonts
== 0;
5383 alter
= XCDR (alter
))
5385 if (STRINGP (XCAR (alter
)))
5387 family
= LSTRDUPA (XCAR (alter
));
5388 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5392 /* Try font family of the default face or "fixed". */
5395 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5397 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5400 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5403 /* Try any family with the given registry. */
5405 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5412 /* Return the registry and encoding pattern that fonts for CHARSET
5413 should match. Value is allocated from the heap. */
5416 x_charset_registry (charset
)
5419 Lisp_Object prop
, charset_plist
;
5422 /* Get registry and encoding from the charset's plist. */
5423 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5424 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5428 if (index (XSTRING (prop
)->data
, '-'))
5429 registry
= xstrdup (XSTRING (prop
)->data
);
5432 /* If registry doesn't contain a `-', make it a pattern. */
5433 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5434 strcpy (registry
, XSTRING (prop
)->data
);
5435 strcat (registry
, "*-*");
5438 else if (STRINGP (Vface_default_registry
))
5439 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5441 registry
= xstrdup ("iso8859-1");
5447 /* Return the fontset id of the fontset name or alias name given by
5448 the family attribute of ATTRS on frame F. Value is -1 if the
5449 family attribute of ATTRS doesn't name a fontset. */
5452 face_fontset (f
, attrs
)
5456 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5459 name
= Fquery_fontset (name
, Qnil
);
5463 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5469 /* Get the font to use for the face realizing the fully-specified Lisp
5470 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5471 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5472 in this case. Value is the font name which is allocated from the
5473 heap (which means that it must be freed eventually). */
5476 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5480 Lisp_Object unibyte_registry
;
5482 struct font_name
*fonts
;
5486 /* ATTRS must be fully-specified. */
5487 xassert (lface_fully_specified_p (attrs
));
5489 if (STRINGP (unibyte_registry
))
5490 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5492 registry
= x_charset_registry (charset
);
5494 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5496 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5500 /* Choose a font to use on frame F to display CHARSET using FONTSET
5501 with Lisp face attributes specified by ATTRS. CHARSET may be any
5502 valid charset. CHARSET < 0 means unibyte text. If the fontset
5503 doesn't contain a font pattern for charset, use the pattern for
5504 CHARSET_ASCII. Value is the font name which is allocated from the
5505 heap and must be freed by the caller. */
5508 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5511 int fontset
, charset
;
5514 char *font_name
= NULL
;
5515 struct fontset_info
*fontset_info
;
5516 struct font_name
*fonts
;
5519 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5521 /* For unibyte text, use the ASCII font of the fontset. Using the
5522 ASCII font seems to be the most reasonable thing we can do in
5525 charset
= CHARSET_ASCII
;
5527 /* Get the font name pattern to use for CHARSET from the fontset. */
5528 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5529 pattern
= fontset_info
->fontname
[charset
];
5531 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5534 /* Get a list of fonts matching that pattern and choose the
5535 best match for the specified face attributes from it. */
5536 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5537 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5541 #endif /* HAVE_X_WINDOWS */
5545 /***********************************************************************
5547 ***********************************************************************/
5549 /* Realize basic faces on frame F. Value is zero if frame parameters
5550 of F don't contain enough information needed to realize the default
5554 realize_basic_faces (f
)
5559 if (realize_default_face (f
))
5561 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5562 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5563 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5564 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5565 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5566 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5567 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5568 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5569 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5577 /* Realize the default face on frame F. If the face is not fully
5578 specified, make it fully-specified. Attributes of the default face
5579 that are not explicitly specified are taken from frame parameters. */
5582 realize_default_face (f
)
5585 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5587 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5588 Lisp_Object unibyte_registry
;
5589 Lisp_Object frame_font
;
5593 /* If the `default' face is not yet known, create it. */
5594 lface
= lface_from_face_name (f
, Qdefault
, 0);
5598 XSETFRAME (frame
, f
);
5599 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5602 #ifdef HAVE_X_WINDOWS
5605 /* Set frame_font to the value of the `font' frame parameter. */
5606 frame_font
= Fassq (Qfont
, f
->param_alist
);
5607 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5608 frame_font
= XCDR (frame_font
);
5610 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5613 /* If frame_font is a fontset name, don't use that for
5614 determining font-related attributes of the default face
5615 because it is just an artificial name. Use the ASCII font of
5616 the fontset, instead. */
5617 struct font_info
*font_info
;
5618 struct font_name font
;
5621 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5625 /* Set weight etc. from the ASCII font. */
5626 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5629 /* Remember registry and encoding of the frame font. */
5630 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5631 if (STRINGP (unibyte_registry
))
5632 Vface_default_registry
= unibyte_registry
;
5634 Vface_default_registry
= build_string ("iso8859-1");
5636 /* But set the family to the fontset alias name. Implementation
5637 note: When a font is passed to Emacs via `-fn FONT', a
5638 fontset is created in `x-win.el' whose name ends in
5639 `fontset-startup'. This fontset has an alias name that is
5640 equal to frame_font. */
5641 xassert (STRINGP (frame_font
));
5642 font
.name
= LSTRDUPA (frame_font
);
5644 if (!split_font_name (f
, &font
, 1)
5645 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5646 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5647 LFACE_FAMILY (lface
) = frame_font
;
5651 /* Frame parameters contain a real font. Fill default face
5652 attributes from that font. */
5653 if (!set_lface_from_font_name (f
, lface
,
5654 XSTRING (frame_font
)->data
, 0, 0))
5657 /* Remember registry and encoding of the frame font. */
5659 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5660 if (STRINGP (unibyte_registry
))
5661 Vface_default_registry
= unibyte_registry
;
5663 Vface_default_registry
= build_string ("iso8859-1");
5666 #endif /* HAVE_X_WINDOWS */
5668 if (!FRAME_WINDOW_P (f
))
5670 LFACE_FAMILY (lface
) = build_string ("default");
5671 LFACE_SWIDTH (lface
) = Qnormal
;
5672 LFACE_HEIGHT (lface
) = make_number (1);
5673 LFACE_WEIGHT (lface
) = Qnormal
;
5674 LFACE_SLANT (lface
) = Qnormal
;
5677 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5678 LFACE_UNDERLINE (lface
) = Qnil
;
5680 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5681 LFACE_OVERLINE (lface
) = Qnil
;
5683 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5684 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5686 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5687 LFACE_BOX (lface
) = Qnil
;
5689 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5690 LFACE_INVERSE (lface
) = Qnil
;
5692 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5694 /* This function is called so early that colors are not yet
5695 set in the frame parameter list. */
5696 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5698 if (CONSP (color
) && STRINGP (XCDR (color
)))
5699 LFACE_FOREGROUND (lface
) = XCDR (color
);
5700 else if (FRAME_X_P (f
))
5702 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5703 LFACE_FOREGROUND (lface
) = Qunspecified_fg
;
5708 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5710 /* This function is called so early that colors are not yet
5711 set in the frame parameter list. */
5712 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5713 if (CONSP (color
) && STRINGP (XCDR (color
)))
5714 LFACE_BACKGROUND (lface
) = XCDR (color
);
5715 else if (FRAME_X_P (f
))
5717 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5718 LFACE_BACKGROUND (lface
) = Qunspecified_bg
;
5723 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5724 LFACE_STIPPLE (lface
) = Qnil
;
5726 /* Realize the face; it must be fully-specified now. */
5727 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5728 check_lface (lface
);
5729 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5730 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5732 /* Remove the former default face. */
5733 if (c
->used
> DEFAULT_FACE_ID
)
5735 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5736 uncache_face (c
, default_face
);
5737 free_realized_face (f
, default_face
);
5740 /* Insert the new default face. */
5741 cache_face (c
, face
, lface_hash (attrs
));
5742 xassert (face
->id
== DEFAULT_FACE_ID
);
5747 /* Realize basic faces other than the default face in face cache C.
5748 SYMBOL is the face name, ID is the face id the realized face must
5749 have. The default face must have been realized already. */
5752 realize_named_face (f
, symbol
, id
)
5757 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5758 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5759 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5760 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5761 struct face
*new_face
;
5763 /* The default face must exist and be fully specified. */
5764 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5765 check_lface_attrs (attrs
);
5766 xassert (lface_fully_specified_p (attrs
));
5768 /* If SYMBOL isn't know as a face, create it. */
5772 XSETFRAME (frame
, f
);
5773 lface
= Finternal_make_lisp_face (symbol
, frame
);
5776 /* Merge SYMBOL's face with the default face. */
5777 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5778 merge_face_vectors (symbol_attrs
, attrs
);
5780 /* Realize the face. */
5781 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5783 /* Remove the former face. */
5786 struct face
*old_face
= c
->faces_by_id
[id
];
5787 uncache_face (c
, old_face
);
5788 free_realized_face (f
, old_face
);
5791 /* Insert the new face. */
5792 cache_face (c
, new_face
, lface_hash (attrs
));
5793 xassert (new_face
->id
== id
);
5797 /* Realize the fully-specified face with attributes ATTRS in face
5798 cache C for character set CHARSET or for unibyte text if CHARSET <
5799 0. Value is a pointer to the newly created realized face. */
5801 static struct face
*
5802 realize_face (c
, attrs
, charset
)
5803 struct face_cache
*c
;
5809 /* LFACE must be fully specified. */
5810 xassert (c
!= NULL
);
5811 check_lface_attrs (attrs
);
5813 if (FRAME_X_P (c
->f
))
5814 face
= realize_x_face (c
, attrs
, charset
);
5815 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5816 face
= realize_tty_face (c
, attrs
, charset
);
5824 /* Realize the fully-specified face with attributes ATTRS in face
5825 cache C for character set CHARSET or for unibyte text if CHARSET <
5826 0. Do it for X frame C->f. Value is a pointer to the newly
5827 created realized face. */
5829 static struct face
*
5830 realize_x_face (c
, attrs
, charset
)
5831 struct face_cache
*c
;
5835 #ifdef HAVE_X_WINDOWS
5836 struct face
*face
, *default_face
;
5838 Lisp_Object stipple
, overline
, strike_through
, box
;
5839 Lisp_Object unibyte_registry
;
5840 struct gcpro gcpro1
;
5842 xassert (FRAME_X_P (f
));
5844 /* If realizing a face for use in unibyte text, get the X registry
5845 and encoding to use from Vface_default_registry. */
5847 unibyte_registry
= (STRINGP (Vface_default_registry
)
5848 ? Vface_default_registry
5849 : build_string ("iso8859-1"));
5851 unibyte_registry
= Qnil
;
5852 GCPRO1 (unibyte_registry
);
5854 /* Allocate a new realized face. */
5855 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5858 /* Determine the font to use. Most of the time, the font will be
5859 the same as the font of the default face, so try that first. */
5860 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5862 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5863 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5865 face
->font
= default_face
->font
;
5866 face
->fontset
= default_face
->fontset
;
5867 face
->font_info_id
= default_face
->font_info_id
;
5868 face
->font_name
= default_face
->font_name
;
5869 face
->registry
= default_face
->registry
;
5871 else if (charset
>= 0)
5873 /* For all charsets, we use our own font selection functions to
5874 choose a best matching font for the specified face
5875 attributes. If the face specifies a fontset alias name, the
5876 fontset determines the font name pattern, otherwise we
5877 construct a font pattern from face attributes and charset. */
5879 char *font_name
= NULL
;
5880 int fontset
= face_fontset (f
, attrs
);
5883 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5886 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5890 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5895 /* Unibyte case, and font is not equal to that of the default
5896 face. UNIBYTE_REGISTRY is the X registry and encoding the
5897 font should have. What is a reasonable thing to do if the
5898 user specified a fontset alias name for the face in this
5899 case? We choose a font by taking the ASCII font of the
5900 fontset, but using UNIBYTE_REGISTRY for its registry and
5903 char *font_name
= NULL
;
5904 int fontset
= face_fontset (f
, attrs
);
5907 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5909 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5911 load_face_font_or_fontset (f
, face
, font_name
, -1);
5915 /* Load colors, and set remaining attributes. */
5917 load_face_colors (f
, face
, attrs
);
5920 box
= attrs
[LFACE_BOX_INDEX
];
5923 /* A simple box of line width 1 drawn in color given by
5925 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5927 face
->box
= FACE_SIMPLE_BOX
;
5928 face
->box_line_width
= 1;
5930 else if (INTEGERP (box
))
5932 /* Simple box of specified line width in foreground color of the
5934 xassert (XINT (box
) > 0);
5935 face
->box
= FACE_SIMPLE_BOX
;
5936 face
->box_line_width
= XFASTINT (box
);
5937 face
->box_color
= face
->foreground
;
5938 face
->box_color_defaulted_p
= 1;
5940 else if (CONSP (box
))
5942 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5943 being one of `raised' or `sunken'. */
5944 face
->box
= FACE_SIMPLE_BOX
;
5945 face
->box_color
= face
->foreground
;
5946 face
->box_color_defaulted_p
= 1;
5947 face
->box_line_width
= 1;
5951 Lisp_Object keyword
, value
;
5953 keyword
= XCAR (box
);
5961 if (EQ (keyword
, QCline_width
))
5963 if (INTEGERP (value
) && XINT (value
) > 0)
5964 face
->box_line_width
= XFASTINT (value
);
5966 else if (EQ (keyword
, QCcolor
))
5968 if (STRINGP (value
))
5970 face
->box_color
= load_color (f
, face
, value
,
5972 face
->use_box_color_for_shadows_p
= 1;
5975 else if (EQ (keyword
, QCstyle
))
5977 if (EQ (value
, Qreleased_button
))
5978 face
->box
= FACE_RAISED_BOX
;
5979 else if (EQ (value
, Qpressed_button
))
5980 face
->box
= FACE_SUNKEN_BOX
;
5985 /* Text underline, overline, strike-through. */
5987 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5989 /* Use default color (same as foreground color). */
5990 face
->underline_p
= 1;
5991 face
->underline_defaulted_p
= 1;
5992 face
->underline_color
= 0;
5994 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5996 /* Use specified color. */
5997 face
->underline_p
= 1;
5998 face
->underline_defaulted_p
= 0;
5999 face
->underline_color
6000 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6001 LFACE_UNDERLINE_INDEX
);
6003 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6005 face
->underline_p
= 0;
6006 face
->underline_defaulted_p
= 0;
6007 face
->underline_color
= 0;
6010 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6011 if (STRINGP (overline
))
6013 face
->overline_color
6014 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6015 LFACE_OVERLINE_INDEX
);
6016 face
->overline_p
= 1;
6018 else if (EQ (overline
, Qt
))
6020 face
->overline_color
= face
->foreground
;
6021 face
->overline_color_defaulted_p
= 1;
6022 face
->overline_p
= 1;
6025 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6026 if (STRINGP (strike_through
))
6028 face
->strike_through_color
6029 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6030 LFACE_STRIKE_THROUGH_INDEX
);
6031 face
->strike_through_p
= 1;
6033 else if (EQ (strike_through
, Qt
))
6035 face
->strike_through_color
= face
->foreground
;
6036 face
->strike_through_color_defaulted_p
= 1;
6037 face
->strike_through_p
= 1;
6040 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6041 if (!NILP (stipple
))
6042 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6045 xassert (face
->fontset
< 0);
6046 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6048 #endif /* HAVE_X_WINDOWS */
6052 /* Realize the fully-specified face with attributes ATTRS in face
6053 cache C for character set CHARSET or for unibyte text if CHARSET <
6054 0. Do it for TTY frame C->f. Value is a pointer to the newly
6055 created realized face. */
6057 static struct face
*
6058 realize_tty_face (c
, attrs
, charset
)
6059 struct face_cache
*c
;
6066 Lisp_Object tty_color_alist
= Fsymbol_value (intern ("tty-color-alist"));
6067 int face_colors_defaulted
= 0;
6069 /* Frame must be a termcap frame. */
6070 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6072 /* Allocate a new realized face. */
6073 face
= make_realized_face (attrs
, charset
, Qnil
);
6074 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6076 /* Map face attributes to TTY appearances. We map slant to
6077 dimmed text because we want italic text to appear differently
6078 and because dimmed text is probably used infrequently. */
6079 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6080 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6082 if (weight
> XLFD_WEIGHT_MEDIUM
)
6083 face
->tty_bold_p
= 1;
6084 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6085 face
->tty_dim_p
= 1;
6086 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6087 face
->tty_underline_p
= 1;
6088 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6089 face
->tty_reverse_p
= 1;
6091 /* Map color names to color indices. */
6092 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6093 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6095 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6097 && XSTRING (color
)->size
6098 && !NILP (tty_color_alist
)
6099 && (color
= Fassoc (color
, tty_color_alist
),
6101 /* Associations in tty-color-alist are of the form
6102 (NAME INDEX R G B). We need the INDEX part. */
6103 face
->foreground
= XINT (XCAR (XCDR (color
)));
6105 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6106 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6108 face
->foreground
= load_color (c
->f
, face
,
6109 attrs
[LFACE_FOREGROUND_INDEX
],
6110 LFACE_FOREGROUND_INDEX
);
6112 /* If the foreground of the default face is the default color,
6113 use the foreground color defined by the frame. */
6114 if (FRAME_MSDOS_P (c
->f
))
6116 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6117 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6119 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6120 attrs
[LFACE_FOREGROUND_INDEX
] =
6121 msdos_stdcolor_name (face
->foreground
);
6122 face_colors_defaulted
= 1;
6124 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6126 face
->foreground
= FRAME_BACKGROUND_PIXEL (f
);
6127 attrs
[LFACE_FOREGROUND_INDEX
] =
6128 msdos_stdcolor_name (face
->foreground
);
6129 face_colors_defaulted
= 1;
6135 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6137 && XSTRING (color
)->size
6138 && !NILP (tty_color_alist
)
6139 && (color
= Fassoc (color
, tty_color_alist
),
6141 /* Associations in tty-color-alist are of the form
6142 (NAME INDEX R G B). We need the INDEX part. */
6143 face
->background
= XINT (XCAR (XCDR (color
)));
6145 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6146 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6148 face
->background
= load_color (c
->f
, face
,
6149 attrs
[LFACE_BACKGROUND_INDEX
],
6150 LFACE_BACKGROUND_INDEX
);
6152 /* If the background of the default face is the default color,
6153 use the background color defined by the frame. */
6154 if (FRAME_MSDOS_P (c
->f
))
6156 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6157 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6159 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6160 attrs
[LFACE_BACKGROUND_INDEX
] =
6161 msdos_stdcolor_name (face
->background
);
6162 face_colors_defaulted
= 1;
6164 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6166 face
->background
= FRAME_FOREGROUND_PIXEL (f
);
6167 attrs
[LFACE_BACKGROUND_INDEX
] =
6168 msdos_stdcolor_name (face
->background
);
6169 face_colors_defaulted
= 1;
6175 /* Swap colors if face is inverse-video. If the colors are taken
6176 from the frame colors, they are already inverted, since the
6177 frame-creation function calls x-handle-reverse-video. */
6178 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6180 unsigned long tem
= face
->foreground
;
6182 face
->foreground
= face
->background
;
6183 face
->background
= tem
;
6191 /***********************************************************************
6193 ***********************************************************************/
6195 /* Return the ID of the face to use to display character CH with face
6196 property PROP on frame F in current_buffer. */
6199 compute_char_face (f
, ch
, prop
)
6205 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6207 : CHAR_CHARSET (ch
));
6210 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6213 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6214 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6215 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6216 merge_face_vector_with_property (f
, attrs
, prop
);
6217 face_id
= lookup_face (f
, attrs
, charset
);
6224 /* Return the face ID associated with buffer position POS for
6225 displaying ASCII characters. Return in *ENDPTR the position at
6226 which a different face is needed, as far as text properties and
6227 overlays are concerned. W is a window displaying current_buffer.
6229 REGION_BEG, REGION_END delimit the region, so it can be
6232 LIMIT is a position not to scan beyond. That is to limit the time
6233 this function can take.
6235 If MOUSE is non-zero, use the character's mouse-face, not its face.
6237 The face returned is suitable for displaying CHARSET_ASCII if
6238 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6239 the face is suitable for displaying unibyte text. */
6242 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6243 endptr
, limit
, mouse
)
6246 int region_beg
, region_end
;
6251 struct frame
*f
= XFRAME (w
->frame
);
6252 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6253 Lisp_Object prop
, position
;
6255 Lisp_Object
*overlay_vec
;
6258 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6259 Lisp_Object limit1
, end
;
6260 struct face
*default_face
;
6261 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6263 /* W must display the current buffer. We could write this function
6264 to use the frame and buffer of W, but right now it doesn't. */
6265 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6267 XSETFRAME (frame
, f
);
6268 XSETFASTINT (position
, pos
);
6271 if (pos
< region_beg
&& region_beg
< endpos
)
6272 endpos
= region_beg
;
6274 /* Get the `face' or `mouse_face' text property at POS, and
6275 determine the next position at which the property changes. */
6276 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6277 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6278 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6280 endpos
= XINT (end
);
6282 /* Look at properties from overlays. */
6287 /* First try with room for 40 overlays. */
6289 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6290 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6291 &next_overlay
, NULL
);
6293 /* If there are more than 40, make enough space for all, and try
6295 if (noverlays
> len
)
6298 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6299 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6300 &next_overlay
, NULL
);
6303 if (next_overlay
< endpos
)
6304 endpos
= next_overlay
;
6309 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6311 /* Optimize common cases where we can use the default face. */
6314 && !(pos
>= region_beg
&& pos
< region_end
)
6316 || !FRAME_WINDOW_P (f
)
6317 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6318 return DEFAULT_FACE_ID
;
6320 /* Begin with attributes from the default face. */
6321 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6323 /* Merge in attributes specified via text properties. */
6325 merge_face_vector_with_property (f
, attrs
, prop
);
6327 /* Now merge the overlay data. */
6328 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6329 for (i
= 0; i
< noverlays
; i
++)
6334 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6336 merge_face_vector_with_property (f
, attrs
, prop
);
6338 oend
= OVERLAY_END (overlay_vec
[i
]);
6339 oendpos
= OVERLAY_POSITION (oend
);
6340 if (oendpos
< endpos
)
6344 /* If in the region, merge in the region face. */
6345 if (pos
>= region_beg
&& pos
< region_end
)
6347 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6348 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6350 if (region_end
< endpos
)
6351 endpos
= region_end
;
6356 /* Look up a realized face with the given face attributes,
6357 or realize a new one. Charset is ignored for tty frames. */
6358 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6362 /* Compute the face at character position POS in Lisp string STRING on
6363 window W, for charset CHARSET_ASCII.
6365 If STRING is an overlay string, it comes from position BUFPOS in
6366 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6367 not an overlay string. W must display the current buffer.
6368 REGION_BEG and REGION_END give the start and end positions of the
6369 region; both are -1 if no region is visible. BASE_FACE_ID is the
6370 id of the basic face to merge with. It is usually equal to
6371 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6372 for strings displayed in the mode or top line.
6374 Set *ENDPTR to the next position where to check for faces in
6375 STRING; -1 if the face is constant from POS to the end of the
6378 Value is the id of the face to use. The face returned is suitable
6379 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6380 the face is suitable for displaying unibyte text. */
6383 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6384 region_end
, endptr
, base_face_id
)
6388 int region_beg
, region_end
;
6390 enum face_id base_face_id
;
6392 Lisp_Object prop
, position
, end
, limit
;
6393 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6394 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6395 struct face
*base_face
;
6396 int multibyte_p
= STRING_MULTIBYTE (string
);
6398 /* Get the value of the face property at the current position within
6399 STRING. Value is nil if there is no face property. */
6400 XSETFASTINT (position
, pos
);
6401 prop
= Fget_text_property (position
, Qface
, string
);
6403 /* Get the next position at which to check for faces. Value of end
6404 is nil if face is constant all the way to the end of the string.
6405 Otherwise it is a string position where to check faces next.
6406 Limit is the maximum position up to which to check for property
6407 changes in Fnext_single_property_change. Strings are usually
6408 short, so set the limit to the end of the string. */
6409 XSETFASTINT (limit
, XSTRING (string
)->size
);
6410 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6412 *endptr
= XFASTINT (end
);
6416 base_face
= FACE_FROM_ID (f
, base_face_id
);
6417 xassert (base_face
);
6419 /* Optimize the default case that there is no face property and we
6420 are not in the region. */
6422 && (base_face_id
!= DEFAULT_FACE_ID
6423 /* BUFPOS <= 0 means STRING is not an overlay string, so
6424 that the region doesn't have to be taken into account. */
6426 || bufpos
< region_beg
6427 || bufpos
>= region_end
)
6429 /* We can't realize faces for different charsets differently
6430 if we don't have fonts, so we can stop here if not working
6431 on a window-system frame. */
6432 || !FRAME_WINDOW_P (f
)
6433 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6434 return base_face
->id
;
6436 /* Begin with attributes from the base face. */
6437 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6439 /* Merge in attributes specified via text properties. */
6441 merge_face_vector_with_property (f
, attrs
, prop
);
6443 /* If in the region, merge in the region face. */
6445 && bufpos
>= region_beg
6446 && bufpos
< region_end
)
6448 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6449 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6452 /* Look up a realized face with the given face attributes,
6453 or realize a new one. */
6454 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6459 /***********************************************************************
6461 ***********************************************************************/
6465 /* Print the contents of the realized face FACE to stderr. */
6468 dump_realized_face (face
)
6471 fprintf (stderr
, "ID: %d\n", face
->id
);
6472 #ifdef HAVE_X_WINDOWS
6473 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6475 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6477 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6478 fprintf (stderr
, "background: 0x%lx (%s)\n",
6480 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6481 fprintf (stderr
, "font_name: %s (%s)\n",
6483 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6484 #ifdef HAVE_X_WINDOWS
6485 fprintf (stderr
, "font = %p\n", face
->font
);
6487 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6488 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6489 fprintf (stderr
, "underline: %d (%s)\n",
6491 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6492 fprintf (stderr
, "hash: %d\n", face
->hash
);
6493 fprintf (stderr
, "charset: %d\n", face
->charset
);
6497 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6505 fprintf (stderr
, "font selection order: ");
6506 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6507 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6508 fprintf (stderr
, "\n");
6510 fprintf (stderr
, "alternative fonts: ");
6511 debug_print (Vface_alternative_font_family_alist
);
6512 fprintf (stderr
, "\n");
6514 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6515 Fdump_face (make_number (i
));
6520 CHECK_NUMBER (n
, 0);
6521 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6523 error ("Not a valid face");
6524 dump_realized_face (face
);
6531 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6535 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6536 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6537 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6541 #endif /* GLYPH_DEBUG != 0 */
6545 /***********************************************************************
6547 ***********************************************************************/
6552 Qface
= intern ("face");
6554 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6555 staticpro (&Qbitmap_spec_p
);
6556 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6557 staticpro (&Qframe_update_face_colors
);
6559 /* Lisp face attribute keywords. */
6560 QCfamily
= intern (":family");
6561 staticpro (&QCfamily
);
6562 QCheight
= intern (":height");
6563 staticpro (&QCheight
);
6564 QCweight
= intern (":weight");
6565 staticpro (&QCweight
);
6566 QCslant
= intern (":slant");
6567 staticpro (&QCslant
);
6568 QCunderline
= intern (":underline");
6569 staticpro (&QCunderline
);
6570 QCinverse_video
= intern (":inverse-video");
6571 staticpro (&QCinverse_video
);
6572 QCreverse_video
= intern (":reverse-video");
6573 staticpro (&QCreverse_video
);
6574 QCforeground
= intern (":foreground");
6575 staticpro (&QCforeground
);
6576 QCbackground
= intern (":background");
6577 staticpro (&QCbackground
);
6578 QCstipple
= intern (":stipple");;
6579 staticpro (&QCstipple
);
6580 QCwidth
= intern (":width");
6581 staticpro (&QCwidth
);
6582 QCfont
= intern (":font");
6583 staticpro (&QCfont
);
6584 QCbold
= intern (":bold");
6585 staticpro (&QCbold
);
6586 QCitalic
= intern (":italic");
6587 staticpro (&QCitalic
);
6588 QCoverline
= intern (":overline");
6589 staticpro (&QCoverline
);
6590 QCstrike_through
= intern (":strike-through");
6591 staticpro (&QCstrike_through
);
6592 QCbox
= intern (":box");
6595 /* Symbols used for Lisp face attribute values. */
6596 QCcolor
= intern (":color");
6597 staticpro (&QCcolor
);
6598 QCline_width
= intern (":line-width");
6599 staticpro (&QCline_width
);
6600 QCstyle
= intern (":style");
6601 staticpro (&QCstyle
);
6602 Qreleased_button
= intern ("released-button");
6603 staticpro (&Qreleased_button
);
6604 Qpressed_button
= intern ("pressed-button");
6605 staticpro (&Qpressed_button
);
6606 Qnormal
= intern ("normal");
6607 staticpro (&Qnormal
);
6608 Qultra_light
= intern ("ultra-light");
6609 staticpro (&Qultra_light
);
6610 Qextra_light
= intern ("extra-light");
6611 staticpro (&Qextra_light
);
6612 Qlight
= intern ("light");
6613 staticpro (&Qlight
);
6614 Qsemi_light
= intern ("semi-light");
6615 staticpro (&Qsemi_light
);
6616 Qsemi_bold
= intern ("semi-bold");
6617 staticpro (&Qsemi_bold
);
6618 Qbold
= intern ("bold");
6620 Qextra_bold
= intern ("extra-bold");
6621 staticpro (&Qextra_bold
);
6622 Qultra_bold
= intern ("ultra-bold");
6623 staticpro (&Qultra_bold
);
6624 Qoblique
= intern ("oblique");
6625 staticpro (&Qoblique
);
6626 Qitalic
= intern ("italic");
6627 staticpro (&Qitalic
);
6628 Qreverse_oblique
= intern ("reverse-oblique");
6629 staticpro (&Qreverse_oblique
);
6630 Qreverse_italic
= intern ("reverse-italic");
6631 staticpro (&Qreverse_italic
);
6632 Qultra_condensed
= intern ("ultra-condensed");
6633 staticpro (&Qultra_condensed
);
6634 Qextra_condensed
= intern ("extra-condensed");
6635 staticpro (&Qextra_condensed
);
6636 Qcondensed
= intern ("condensed");
6637 staticpro (&Qcondensed
);
6638 Qsemi_condensed
= intern ("semi-condensed");
6639 staticpro (&Qsemi_condensed
);
6640 Qsemi_expanded
= intern ("semi-expanded");
6641 staticpro (&Qsemi_expanded
);
6642 Qexpanded
= intern ("expanded");
6643 staticpro (&Qexpanded
);
6644 Qextra_expanded
= intern ("extra-expanded");
6645 staticpro (&Qextra_expanded
);
6646 Qultra_expanded
= intern ("ultra-expanded");
6647 staticpro (&Qultra_expanded
);
6648 Qbackground_color
= intern ("background-color");
6649 staticpro (&Qbackground_color
);
6650 Qforeground_color
= intern ("foreground-color");
6651 staticpro (&Qforeground_color
);
6652 Qunspecified
= intern ("unspecified");
6653 staticpro (&Qunspecified
);
6654 Qunspecified_fg
= intern ("unspecified-fg");
6655 staticpro (&Qunspecified_fg
);
6656 Qunspecified_bg
= intern ("unspecified-bg");
6657 staticpro (&Qunspecified_bg
);
6659 Qx_charset_registry
= intern ("x-charset-registry");
6660 staticpro (&Qx_charset_registry
);
6661 Qface_alias
= intern ("face-alias");
6662 staticpro (&Qface_alias
);
6663 Qdefault
= intern ("default");
6664 staticpro (&Qdefault
);
6665 Qtool_bar
= intern ("tool-bar");
6666 staticpro (&Qtool_bar
);
6667 Qregion
= intern ("region");
6668 staticpro (&Qregion
);
6669 Qfringe
= intern ("fringe");
6670 staticpro (&Qfringe
);
6671 Qheader_line
= intern ("header-line");
6672 staticpro (&Qheader_line
);
6673 Qscroll_bar
= intern ("scroll-bar");
6674 staticpro (&Qscroll_bar
);
6675 Qmenu
= intern ("menu");
6677 Qcursor
= intern ("cursor");
6678 staticpro (&Qcursor
);
6679 Qborder
= intern ("border");
6680 staticpro (&Qborder
);
6681 Qmouse
= intern ("mouse");
6682 staticpro (&Qmouse
);
6683 Qtty_color_desc
= intern ("tty-color-desc");
6684 staticpro (&Qtty_color_desc
);
6685 Qtty_color_by_index
= intern ("tty-color-by-index");
6686 staticpro (&Qtty_color_by_index
);
6688 defsubr (&Sinternal_make_lisp_face
);
6689 defsubr (&Sinternal_lisp_face_p
);
6690 defsubr (&Sinternal_set_lisp_face_attribute
);
6691 #ifdef HAVE_X_WINDOWS
6692 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6693 defsubr (&Sface_color_gray_p
);
6694 defsubr (&Sface_color_supported_p
);
6696 defsubr (&Sinternal_get_lisp_face_attribute
);
6697 defsubr (&Sinternal_lisp_face_attribute_values
);
6698 defsubr (&Sinternal_lisp_face_equal_p
);
6699 defsubr (&Sinternal_lisp_face_empty_p
);
6700 defsubr (&Sinternal_copy_lisp_face
);
6701 defsubr (&Sinternal_merge_in_global_face
);
6702 defsubr (&Sface_font
);
6703 defsubr (&Sframe_face_alist
);
6704 defsubr (&Sinternal_set_font_selection_order
);
6705 defsubr (&Sinternal_set_alternative_font_family_alist
);
6707 defsubr (&Sdump_face
);
6708 defsubr (&Sshow_face_resources
);
6709 #endif /* GLYPH_DEBUG */
6710 defsubr (&Sclear_face_cache
);
6712 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6713 "*Limit for font matching.\n\
6714 If an integer > 0, font matching functions won't load more than\n\
6715 that number of fonts when searching for a matching font.");
6716 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6718 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6719 "List of global face definitions (for internal use only.)");
6720 Vface_new_frame_defaults
= Qnil
;
6722 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6723 "*Default stipple pattern used on monochrome displays.\n\
6724 This stipple pattern is used on monochrome displays\n\
6725 instead of shades of gray for a face background color.\n\
6726 See `set-face-stipple' for possible values for this variable.");
6727 Vface_default_stipple
= build_string ("gray3");
6729 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6730 "Default registry and encoding to use.\n\
6731 This registry and encoding is used for unibyte text. It is set up\n\
6732 from the specified frame font when Emacs starts. (For internal use only.)");
6733 Vface_default_registry
= Qnil
;
6735 DEFVAR_LISP ("face-alternative-font-family-alist",
6736 &Vface_alternative_font_family_alist
, "");
6737 Vface_alternative_font_family_alist
= Qnil
;
6741 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6742 "Allowed scalable fonts.\n\
6743 A value of nil means don't allow any scalable fonts.\n\
6744 A value of t means allow any scalable font.\n\
6745 Otherwise, value must be a list of regular expressions. A font may be\n\
6746 scaled if its name matches a regular expression in the list.");
6747 Vscalable_fonts_allowed
= Qnil
;
6749 #endif /* SCALABLE_FONTS */
6751 #ifdef HAVE_X_WINDOWS
6752 defsubr (&Sbitmap_spec_p
);
6753 defsubr (&Sx_list_fonts
);
6754 defsubr (&Sinternal_face_x_get_resource
);
6755 defsubr (&Sx_family_fonts
);
6756 defsubr (&Sx_font_family_list
);
6757 #endif /* HAVE_X_WINDOWS */