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 Except for composite characters (CHARSET_COMPOSITION), faces are
100 always realized for a specific character set and contain a specific
101 font, even if the face being realized specifies a fontset (see
102 `font selection' below). The reason is that the result of the new
103 font selection stage is better than what can be done with
104 statically defined font name patterns in fontsets.
109 In unibyte text, Emacs' charsets aren't applicable; function
110 `char-charset' reports CHARSET_ASCII for all characters, including
111 those > 0x7f. The X registry and encoding of fonts to use is
112 determined from the variable `x-unibyte-registry-and-encoding' in
113 this case. The variable is initialized at Emacs startup time from
114 the font the user specified for Emacs.
116 Currently all unibyte text, i.e. all buffers with
117 enable_multibyte_characters nil are displayed with fonts of the
118 same registry and encoding `x-unibyte-registry-and-encoding'. This
119 is consistent with the fact that languages can also be set
125 Font selection tries to find the best available matching font for a
126 given (charset, face) combination. This is done slightly
127 differently for faces specifying a fontset, or a font family name.
129 If the face specifies a fontset alias name, that fontset determines
130 a pattern for fonts of the given charset. If the face specifies a
131 font family, a font pattern is constructed. Charset symbols have a
132 property `x-charset-registry' for that purpose that maps a charset
133 to an XLFD registry and encoding in the font pattern constructed.
135 Available fonts on the system on which Emacs runs are then matched
136 against the font pattern. The result of font selection is the best
137 match for the given face attributes in this font list.
139 Font selection can be influenced by the user.
141 1. The user can specify the relative importance he gives the face
142 attributes width, height, weight, and slant by setting
143 face-font-selection-order (faces.el) to a list of face attribute
144 names. The default is '(:width :height :weight :slant), and means
145 that font selection first tries to find a good match for the font
146 width specified by a face, then---within fonts with that
147 width---tries to find a best match for the specified font height,
150 2. Setting face-alternative-font-family-alist allows the user to
151 specify alternative font families to try if a family specified by a
155 Composite characters.
157 Realized faces for composite characters are the only ones having a
158 fontset id >= 0. When a composite character is encoded into a
159 sequence of non-composite characters (in xterm.c), a suitable font
160 for the non-composite characters is then selected and realized,
161 i.e. the realization process is delayed but in principle the same.
164 Initialization of basic faces.
166 The faces `default', `modeline' are considered `basic faces'.
167 When redisplay happens the first time for a newly created frame,
168 basic faces are realized for CHARSET_ASCII. Frame parameters are
169 used to fill in unspecified attributes of the default face. */
171 /* Define SCALABLE_FONTS to a non-zero value to enable scalable
172 font use. Define it to zero to disable scalable font use.
174 Use of too many or too large scalable fonts can crash XFree86
175 servers. That's why I've put the code dealing with scalable fonts
178 #define SCALABLE_FONTS 1
181 #include <sys/types.h>
182 #include <sys/stat.h>
187 #ifdef HAVE_X_WINDOWS
192 #include <Xm/XmStrDefs.h>
193 #endif /* USE_MOTIF */
201 #include "dispextern.h"
202 #include "blockinput.h"
204 #include "intervals.h"
206 #ifdef HAVE_X_WINDOWS
208 /* Compensate for a bug in Xos.h on some systems, on which it requires
209 time.h. On some such systems, Xos.h tries to redefine struct
210 timeval and struct timezone if USG is #defined while it is
213 #ifdef XOS_NEEDS_TIME_H
219 #else /* not XOS_NEEDS_TIME_H */
221 #endif /* not XOS_NEEDS_TIME_H */
223 #endif /* HAVE_X_WINDOWS */
227 #include "keyboard.h"
230 #define max(A, B) ((A) > (B) ? (A) : (B))
231 #define min(A, B) ((A) < (B) ? (A) : (B))
232 #define abs(X) ((X) < 0 ? -(X) : (X))
235 /* Non-zero if face attribute ATTR is unspecified. */
237 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
239 /* Value is the number of elements of VECTOR. */
241 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
243 /* Make a copy of string S on the stack using alloca. Value is a pointer
246 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
248 /* Make a copy of the contents of Lisp string S on the stack using
249 alloca. Value is a pointer to the copy. */
251 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
253 /* Size of hash table of realized faces in face caches (should be a
256 #define FACE_CACHE_BUCKETS_SIZE 1001
258 /* Keyword symbols used for face attribute names. */
260 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
261 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
262 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
263 Lisp_Object QCreverse_video
;
264 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
266 /* Symbols used for attribute values. */
268 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
269 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
270 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
271 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
272 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
273 Lisp_Object Qultra_expanded
;
274 Lisp_Object Qreleased_button
, Qpressed_button
;
275 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
276 Lisp_Object Qunspecified
;
278 /* The symbol `x-charset-registry'. This property of charsets defines
279 the X registry and encoding that fonts should have that are used to
280 display characters of that charset. */
282 Lisp_Object Qx_charset_registry
;
284 /* The name of the function to call when the background of the frame
285 has changed, frame_update_face_colors. */
287 Lisp_Object Qframe_update_face_colors
;
289 /* Names of basic faces. */
291 Lisp_Object Qdefault
, Qmode_line
, Qtool_bar
, Qregion
, Qfringe
;
292 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
294 /* The symbol `face-alias'. A symbols having that property is an
295 alias for another face. Value of the property is the name of
298 Lisp_Object Qface_alias
;
300 /* Names of frame parameters related to faces. */
302 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
303 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
305 /* Default stipple pattern used on monochrome displays. This stipple
306 pattern is used on monochrome displays instead of shades of gray
307 for a face background color. See `set-face-stipple' for possible
308 values for this variable. */
310 Lisp_Object Vface_default_stipple
;
312 /* Default registry and encoding to use for charsets whose charset
313 symbols don't specify one. */
315 Lisp_Object Vface_default_registry
;
317 /* Alist of alternative font families. Each element is of the form
318 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
319 try FAMILY1, then FAMILY2, ... */
321 Lisp_Object Vface_alternative_font_family_alist
;
323 /* Allowed scalable fonts. A value of nil means don't allow any
324 scalable fonts. A value of t means allow the use of any scalable
325 font. Otherwise, value must be a list of regular expressions. A
326 font may be scaled if its name matches a regular expression in the
330 Lisp_Object Vscalable_fonts_allowed
;
333 /* Maximum number of fonts to consider in font_list. If not an
334 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
336 Lisp_Object Vfont_list_limit
;
337 #define DEFAULT_FONT_LIST_LIMIT 100
339 /* The symbols `foreground-color' and `background-color' which can be
340 used as part of a `face' property. This is for compatibility with
343 Lisp_Object Qforeground_color
, Qbackground_color
;
345 /* The symbols `face' and `mouse-face' used as text properties. */
348 extern Lisp_Object Qmouse_face
;
350 /* Error symbol for wrong_type_argument in load_pixmap. */
352 Lisp_Object Qbitmap_spec_p
;
354 /* Alist of global face definitions. Each element is of the form
355 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
356 is a Lisp vector of face attributes. These faces are used
357 to initialize faces for new frames. */
359 Lisp_Object Vface_new_frame_defaults
;
361 /* The next ID to assign to Lisp faces. */
363 static int next_lface_id
;
365 /* A vector mapping Lisp face Id's to face names. */
367 static Lisp_Object
*lface_id_to_name
;
368 static int lface_id_to_name_size
;
370 /* An alist of elements (COLOR-NAME . INDEX) mapping color names
371 to color indices for tty frames. */
373 Lisp_Object Vface_tty_color_alist
;
375 /* Counter for calls to clear_face_cache. If this counter reaches
376 CLEAR_FONT_TABLE_COUNT, and a frame has more than
377 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
379 static int clear_font_table_count
;
380 #define CLEAR_FONT_TABLE_COUNT 100
381 #define CLEAR_FONT_TABLE_NFONTS 10
383 /* Non-zero means face attributes have been changed since the last
384 redisplay. Used in redisplay_internal. */
386 int face_change_count
;
388 /* The total number of colors currently allocated. */
391 static int ncolors_allocated
;
392 static int npixmaps_allocated
;
398 /* Function prototypes. */
403 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
404 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
405 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
406 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
408 static int first_font_matching
P_ ((struct frame
*f
, char *,
409 struct font_name
*));
410 static int x_face_list_fonts
P_ ((struct frame
*, char *,
411 struct font_name
*, int, int, int));
412 static int font_scalable_p
P_ ((struct font_name
*));
413 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
414 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
415 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
416 static char *xstrdup
P_ ((char *));
417 static unsigned char *xstrlwr
P_ ((unsigned char *));
418 static void signal_error
P_ ((char *, Lisp_Object
));
419 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
420 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
421 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
422 static void free_face_colors
P_ ((struct frame
*, struct face
*));
423 static int face_color_gray_p
P_ ((struct frame
*, char *));
424 static char *build_font_name
P_ ((struct font_name
*));
425 static void free_font_names
P_ ((struct font_name
*, int));
426 static int sorted_font_list
P_ ((struct frame
*, char *,
427 int (*cmpfn
) P_ ((const void *, const void *)),
428 struct font_name
**));
429 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
430 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
431 struct font_name
**));
432 static int cmp_font_names
P_ ((const void *, const void *));
433 static struct face
*realize_face
P_ ((struct face_cache
*,
434 Lisp_Object
*, int));
435 static struct face
*realize_x_face
P_ ((struct face_cache
*,
436 Lisp_Object
*, int));
437 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
438 Lisp_Object
*, int));
439 static int realize_basic_faces
P_ ((struct frame
*));
440 static int realize_default_face
P_ ((struct frame
*));
441 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
442 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
443 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
444 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
445 static unsigned lface_hash
P_ ((Lisp_Object
*));
446 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
447 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
448 static void free_realized_face
P_ ((struct frame
*, struct face
*));
449 static void clear_face_gcs
P_ ((struct face_cache
*));
450 static void free_face_cache
P_ ((struct face_cache
*));
451 static int face_numeric_weight
P_ ((Lisp_Object
));
452 static int face_numeric_slant
P_ ((Lisp_Object
));
453 static int face_numeric_swidth
P_ ((Lisp_Object
));
454 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
455 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
457 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
459 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
460 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
462 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
464 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
465 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
466 static void free_realized_faces
P_ ((struct face_cache
*));
467 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
468 struct font_name
*, int));
469 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
470 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
471 static int xlfd_numeric_slant
P_ ((struct font_name
*));
472 static int xlfd_numeric_weight
P_ ((struct font_name
*));
473 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
474 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
475 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
476 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
477 static int xlfd_fixed_p
P_ ((struct font_name
*));
478 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
480 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
481 struct font_name
*, int, int));
482 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
483 struct font_name
*, int));
485 #ifdef HAVE_X_WINDOWS
487 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
488 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
489 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
490 int (*cmpfn
) P_ ((const void *, const void *))));
491 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
492 static void x_free_gc
P_ ((struct frame
*, GC
));
493 static void clear_font_table
P_ ((struct frame
*));
495 #endif /* HAVE_X_WINDOWS */
498 /***********************************************************************
500 ***********************************************************************/
502 #ifdef HAVE_X_WINDOWS
504 /* Create and return a GC for use on frame F. GC values and mask
505 are given by XGCV and MASK. */
508 x_create_gc (f
, mask
, xgcv
)
515 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
522 /* Free GC which was used on frame F. */
530 xassert (--ngcs
>= 0);
531 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
535 #endif /* HAVE_X_WINDOWS */
538 /* Like strdup, but uses xmalloc. */
544 int len
= strlen (s
) + 1;
545 char *p
= (char *) xmalloc (len
);
551 /* Like stricmp. Used to compare parts of font names which are in
556 unsigned char *s1
, *s2
;
560 unsigned char c1
= tolower (*s1
);
561 unsigned char c2
= tolower (*s2
);
563 return c1
< c2
? -1 : 1;
568 return *s2
== 0 ? 0 : -1;
573 /* Like strlwr, which might not always be available. */
575 static unsigned char *
579 unsigned char *p
= s
;
588 /* Signal `error' with message S, and additional argument ARG. */
591 signal_error (s
, arg
)
595 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
599 /* If FRAME is nil, return a pointer to the selected frame.
600 Otherwise, check that FRAME is a live frame, and return a pointer
601 to it. NPARAM is the parameter number of FRAME, for
602 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
603 Lisp function definitions. */
605 static INLINE
struct frame
*
606 frame_or_selected_frame (frame
, nparam
)
611 frame
= selected_frame
;
613 CHECK_LIVE_FRAME (frame
, nparam
);
614 return XFRAME (frame
);
618 /***********************************************************************
620 ***********************************************************************/
622 /* Initialize face cache and basic faces for frame F. */
628 /* Make a face cache, if F doesn't have one. */
629 if (FRAME_FACE_CACHE (f
) == NULL
)
630 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
632 #ifdef HAVE_X_WINDOWS
633 /* Make the image cache. */
636 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
637 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
638 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
640 #endif /* HAVE_X_WINDOWS */
642 /* Realize basic faces. Must have enough information in frame
643 parameters to realize basic faces at this point. */
644 #ifdef HAVE_X_WINDOWS
645 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
647 if (!realize_basic_faces (f
))
652 /* Free face cache of frame F. Called from Fdelete_frame. */
658 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
662 free_face_cache (face_cache
);
663 FRAME_FACE_CACHE (f
) = NULL
;
666 #ifdef HAVE_X_WINDOWS
669 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
672 --image_cache
->refcount
;
673 if (image_cache
->refcount
== 0)
674 free_image_cache (f
);
677 #endif /* HAVE_X_WINDOWS */
681 /* Clear face caches, and recompute basic faces for frame F. Call
682 this after changing frame parameters on which those faces depend,
683 or when realized faces have been freed due to changing attributes
687 recompute_basic_faces (f
)
690 if (FRAME_FACE_CACHE (f
))
693 clear_face_cache (0);
694 realized_p
= realize_basic_faces (f
);
695 xassert (realized_p
);
700 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
701 try to free unused fonts, too. */
704 clear_face_cache (clear_fonts_p
)
707 #ifdef HAVE_X_WINDOWS
708 Lisp_Object tail
, frame
;
712 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
714 /* From time to time see if we can unload some fonts. This also
715 frees all realized faces on all frames. Fonts needed by
716 faces will be loaded again when faces are realized again. */
717 clear_font_table_count
= 0;
719 FOR_EACH_FRAME (tail
, frame
)
723 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
725 free_all_realized_faces (frame
);
726 clear_font_table (f
);
732 /* Clear GCs of realized faces. */
733 FOR_EACH_FRAME (tail
, frame
)
738 clear_face_gcs (FRAME_FACE_CACHE (f
));
739 clear_image_cache (f
, 0);
743 #endif /* HAVE_X_WINDOWS */
747 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
748 "Clear face caches on all frames.\n\
749 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
751 Lisp_Object thorougly
;
753 clear_face_cache (!NILP (thorougly
));
759 #ifdef HAVE_X_WINDOWS
762 /* Remove those fonts from the font table of frame F that are not used
763 by fontsets. Called from clear_face_cache from time to time. */
769 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
771 Lisp_Object rest
, frame
;
774 xassert (FRAME_X_P (f
));
776 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
777 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
779 /* For all frames with the same x_display_info as F, record
780 in `used' those fonts that are in use by fontsets. */
781 FOR_EACH_FRAME (rest
, frame
)
782 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
784 struct frame
*f
= XFRAME (frame
);
785 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
787 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
789 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
792 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
794 int idx
= info
->font_indexes
[j
];
801 /* Free those fonts that are not used by fontsets. */
802 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
803 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
805 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
807 /* Free names. In xfns.c there is a comment that full_name
808 should never be freed because it is always shared with
809 something else. I don't think this is true anymore---see
810 x_load_font. It's either equal to font_info->name or
811 allocated via xmalloc, and there seems to be no place in
812 the source files where full_name is transferred to another
814 if (font_info
->full_name
!= font_info
->name
)
815 xfree (font_info
->full_name
);
816 xfree (font_info
->name
);
820 XFreeFont (dpyinfo
->display
, font_info
->font
);
823 /* Mark font table slot free. */
824 font_info
->font
= NULL
;
825 font_info
->name
= font_info
->full_name
= NULL
;
830 #endif /* HAVE_X_WINDOWS */
834 /***********************************************************************
836 ***********************************************************************/
838 #ifdef HAVE_X_WINDOWS
840 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
841 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
842 A bitmap specification is either a string, a file name, or a list\n\
843 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
844 HEIGHT is its height, and DATA is a string containing the bits of\n\
845 the pixmap. Bits are stored row by row, each row occupies\n\
846 (WIDTH + 7)/8 bytes.")
852 if (STRINGP (object
))
853 /* If OBJECT is a string, it's a file name. */
855 else if (CONSP (object
))
857 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
858 HEIGHT must be integers > 0, and DATA must be string large
859 enough to hold a bitmap of the specified size. */
860 Lisp_Object width
, height
, data
;
862 height
= width
= data
= Qnil
;
866 width
= XCAR (object
);
867 object
= XCDR (object
);
870 height
= XCAR (object
);
871 object
= XCDR (object
);
873 data
= XCAR (object
);
877 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
879 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
881 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
886 return pixmap_p
? Qt
: Qnil
;
890 /* Load a bitmap according to NAME (which is either a file name or a
891 pixmap spec) for use on frame F. Value is the bitmap_id (see
892 xfns.c). If NAME is nil, return with a bitmap id of zero. If
893 bitmap cannot be loaded, display a message saying so, and return
894 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
895 if these pointers are not null. */
898 load_pixmap (f
, name
, w_ptr
, h_ptr
)
901 unsigned int *w_ptr
, *h_ptr
;
909 tem
= Fbitmap_spec_p (name
);
911 wrong_type_argument (Qbitmap_spec_p
, name
);
916 /* Decode a bitmap spec into a bitmap. */
921 w
= XINT (Fcar (name
));
922 h
= XINT (Fcar (Fcdr (name
)));
923 bits
= Fcar (Fcdr (Fcdr (name
)));
925 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
930 /* It must be a string -- a file name. */
931 bitmap_id
= x_create_bitmap_from_file (f
, name
);
937 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
948 ++npixmaps_allocated
;
951 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
954 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
960 #endif /* HAVE_X_WINDOWS */
964 /***********************************************************************
966 ***********************************************************************/
968 #ifdef HAVE_X_WINDOWS
970 /* Update the line_height of frame F. Return non-zero if line height
974 frame_update_line_height (f
)
977 int fontset
, line_height
, changed_p
;
979 fontset
= f
->output_data
.x
->fontset
;
981 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
983 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
985 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
986 f
->output_data
.x
->line_height
= line_height
;
990 #endif /* HAVE_X_WINDOWS */
993 /***********************************************************************
995 ***********************************************************************/
997 #ifdef HAVE_X_WINDOWS
999 /* Load font or fontset of face FACE which is used on frame F.
1000 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1001 fontset. FONT_NAME is the name of the font to load, if no fontset
1002 is used. It is null if no suitable font name could be determined
1006 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1012 struct font_info
*font_info
= NULL
;
1014 face
->font_info_id
= -1;
1015 face
->fontset
= fontset
;
1020 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1023 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1032 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1033 face
->font
= font_info
->font
;
1034 face
->font_name
= font_info
->full_name
;
1036 /* Make the registry part of the font name readily accessible.
1037 The registry is used to find suitable faces for unibyte text. */
1038 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1040 while (i
< 2 && --s
>= font_info
->full_name
)
1044 if (!STRINGP (face
->registry
)
1045 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1047 if (STRINGP (Vface_default_registry
)
1048 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1049 face
->registry
= Vface_default_registry
;
1051 face
->registry
= build_string (s
+ 1);
1054 else if (fontset
>= 0)
1055 add_to_log ("Unable to load ASCII font of fontset %d",
1056 make_number (fontset
), Qnil
);
1058 add_to_log ("Unable to load font %s",
1059 build_string (font_name
), Qnil
);
1062 #endif /* HAVE_X_WINDOWS */
1066 /***********************************************************************
1068 ***********************************************************************/
1070 #ifdef HAVE_X_WINDOWS
1072 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1073 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1076 face_color_gray_p (f
, color_name
)
1083 if (defined_color (f
, color_name
, &color
, 0))
1084 gray_p
= ((abs (color
.red
- color
.green
)
1085 < max (color
.red
, color
.green
) / 20)
1086 && (abs (color
.green
- color
.blue
)
1087 < max (color
.green
, color
.blue
) / 20)
1088 && (abs (color
.blue
- color
.red
)
1089 < max (color
.blue
, color
.red
) / 20));
1097 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1098 BACKGROUND_P non-zero means the color will be used as background
1102 face_color_supported_p (f
, color_name
, background_p
)
1109 XSETFRAME (frame
, f
);
1110 return (!NILP (Vwindow_system
)
1111 && (!NILP (Fx_display_color_p (frame
))
1112 || xstricmp (color_name
, "black") == 0
1113 || xstricmp (color_name
, "white") == 0
1115 && face_color_gray_p (f
, color_name
))
1116 || (!NILP (Fx_display_grayscale_p (frame
))
1117 && face_color_gray_p (f
, color_name
))));
1121 DEFUN ("face-color-gray-p", Fface_color_gray_p
, Sface_color_gray_p
, 1, 2, 0,
1122 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1123 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1124 If FRAME is nil or omitted, use the selected frame.")
1126 Lisp_Object color
, frame
;
1128 struct frame
*f
= check_x_frame (frame
);
1129 CHECK_STRING (color
, 0);
1130 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1134 DEFUN ("face-color-supported-p", Fface_color_supported_p
,
1135 Sface_color_supported_p
, 2, 3, 0,
1136 "Return non-nil if COLOR can be displayed on FRAME.\n\
1137 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1138 If FRAME is nil or omitted, use the selected frame.\n\
1139 COLOR must be a valid color name.")
1140 (frame
, color
, background_p
)
1141 Lisp_Object frame
, color
, background_p
;
1143 struct frame
*f
= check_x_frame (frame
);
1144 CHECK_STRING (color
, 0);
1145 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1150 /* Load color with name NAME for use by face FACE on frame F.
1151 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1152 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1153 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1154 pixel color. If color cannot be loaded, display a message, and
1155 return the foreground, background or underline color of F, but
1156 record that fact in flags of the face so that we don't try to free
1160 load_color (f
, face
, name
, target_index
)
1164 enum lface_attribute_index target_index
;
1168 xassert (STRINGP (name
));
1169 xassert (target_index
== LFACE_FOREGROUND_INDEX
1170 || target_index
== LFACE_BACKGROUND_INDEX
1171 || target_index
== LFACE_UNDERLINE_INDEX
1172 || target_index
== LFACE_OVERLINE_INDEX
1173 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1174 || target_index
== LFACE_BOX_INDEX
);
1176 /* if the color map is full, defined_color will return a best match
1177 to the values in an existing cell. */
1178 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1180 add_to_log ("Unable to load color %s", name
, Qnil
);
1182 switch (target_index
)
1184 case LFACE_FOREGROUND_INDEX
:
1185 face
->foreground_defaulted_p
= 1;
1186 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1189 case LFACE_BACKGROUND_INDEX
:
1190 face
->background_defaulted_p
= 1;
1191 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1194 case LFACE_UNDERLINE_INDEX
:
1195 face
->underline_defaulted_p
= 1;
1196 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1199 case LFACE_OVERLINE_INDEX
:
1200 face
->overline_color_defaulted_p
= 1;
1201 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1204 case LFACE_STRIKE_THROUGH_INDEX
:
1205 face
->strike_through_color_defaulted_p
= 1;
1206 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1209 case LFACE_BOX_INDEX
:
1210 face
->box_color_defaulted_p
= 1;
1211 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1220 ++ncolors_allocated
;
1227 /* Load colors for face FACE which is used on frame F. Colors are
1228 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1229 of ATTRS. If the background color specified is not supported on F,
1230 try to emulate gray colors with a stipple from Vface_default_stipple. */
1233 load_face_colors (f
, face
, attrs
)
1240 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1241 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1243 /* Swap colors if face is inverse-video. */
1244 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1252 /* Check for support for foreground, not for background because
1253 face_color_supported_p is smart enough to know that grays are
1254 "supported" as background because we are supposed to use stipple
1256 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1257 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1259 x_destroy_bitmap (f
, face
->stipple
);
1260 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1261 &face
->pixmap_w
, &face
->pixmap_h
);
1264 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1265 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1269 /* Free color PIXEL on frame F. */
1272 unload_color (f
, pixel
)
1274 unsigned long pixel
;
1276 Display
*dpy
= FRAME_X_DISPLAY (f
);
1277 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1279 if (pixel
== BLACK_PIX_DEFAULT (f
)
1280 || pixel
== WHITE_PIX_DEFAULT (f
))
1285 /* If display has an immutable color map, freeing colors is not
1286 necessary and some servers don't allow it. So don't do it. */
1287 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1289 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1290 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1297 /* Free colors allocated for FACE. */
1300 free_face_colors (f
, face
)
1304 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1306 /* If display has an immutable color map, freeing colors is not
1307 necessary and some servers don't allow it. So don't do it. */
1308 if (class != StaticColor
1309 && class != StaticGray
1310 && class != TrueColor
)
1316 dpy
= FRAME_X_DISPLAY (f
);
1317 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1319 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1320 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1321 && !face
->foreground_defaulted_p
)
1323 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1324 IF_DEBUG (--ncolors_allocated
);
1327 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1328 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1329 && !face
->background_defaulted_p
)
1331 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1332 IF_DEBUG (--ncolors_allocated
);
1335 if (face
->underline_p
1336 && !face
->underline_defaulted_p
1337 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1338 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1340 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1341 IF_DEBUG (--ncolors_allocated
);
1344 if (face
->overline_p
1345 && !face
->overline_color_defaulted_p
1346 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1347 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1349 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1350 IF_DEBUG (--ncolors_allocated
);
1353 if (face
->strike_through_p
1354 && !face
->strike_through_color_defaulted_p
1355 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1356 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1358 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1359 IF_DEBUG (--ncolors_allocated
);
1362 if (face
->box
!= FACE_NO_BOX
1363 && !face
->box_color_defaulted_p
1364 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1365 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1367 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1368 IF_DEBUG (--ncolors_allocated
);
1375 #else /* ! HAVE_X_WINDOWS */
1379 load_color (f
, face
, name
, target_index
)
1383 enum lface_attribute_index target_index
;
1386 int color_idx
= FACE_TTY_DEFAULT_COLOR
;
1389 return (unsigned long)FACE_TTY_DEFAULT_COLOR
;
1391 CHECK_STRING (name
, 0);
1394 if (XSTRING (name
)->size
&& !NILP (Ffboundp (Qmsdos_color_translate
)))
1396 color
= call1 (Qmsdos_color_translate
, name
);
1398 if (INTEGERP (color
))
1399 return (unsigned long)XINT (color
);
1401 add_to_log ("Unable to load color %s", name
, Qnil
);
1403 switch (target_index
)
1405 case LFACE_FOREGROUND_INDEX
:
1406 face
->foreground_defaulted_p
= 1;
1407 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1410 case LFACE_BACKGROUND_INDEX
:
1411 face
->background_defaulted_p
= 1;
1412 color_idx
= FRAME_BACKGROUND_PIXEL (f
);
1415 case LFACE_UNDERLINE_INDEX
:
1416 face
->underline_defaulted_p
= 1;
1417 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1420 case LFACE_OVERLINE_INDEX
:
1421 face
->overline_color_defaulted_p
= 1;
1422 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1425 case LFACE_STRIKE_THROUGH_INDEX
:
1426 face
->strike_through_color_defaulted_p
= 1;
1427 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1430 case LFACE_BOX_INDEX
:
1431 face
->box_color_defaulted_p
= 1;
1432 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1437 color_idx
= msdos_stdcolor_idx (XSTRING (name
)->data
);
1439 return (unsigned long)color_idx
;
1442 #endif /* ! HAVE_X_WINDOWS */
1446 /***********************************************************************
1448 ***********************************************************************/
1450 /* An enumerator for each field of an XLFD font name. */
1471 /* An enumerator for each possible slant value of a font. Taken from
1472 the XLFD specification. */
1480 XLFD_SLANT_REVERSE_ITALIC
,
1481 XLFD_SLANT_REVERSE_OBLIQUE
,
1485 /* Relative font weight according to XLFD documentation. */
1489 XLFD_WEIGHT_UNKNOWN
,
1490 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1491 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1492 XLFD_WEIGHT_LIGHT
, /* 30 */
1493 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1494 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1495 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1496 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1497 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1498 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1501 /* Relative proportionate width. */
1505 XLFD_SWIDTH_UNKNOWN
,
1506 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1507 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1508 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1509 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1510 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1511 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1512 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1513 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1514 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1517 /* Structure used for tables mapping XLFD weight, slant, and width
1518 names to numeric and symbolic values. */
1524 Lisp_Object
*symbol
;
1527 /* Table of XLFD slant names and their numeric and symbolic
1528 representations. This table must be sorted by slant names in
1531 static struct table_entry slant_table
[] =
1533 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1534 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1535 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1536 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1537 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1538 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1541 /* Table of XLFD weight names. This table must be sorted by weight
1542 names in ascending order. */
1544 static struct table_entry weight_table
[] =
1546 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1547 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1548 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1549 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1550 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1551 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1552 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1553 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1554 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1555 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1556 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1557 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1558 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1559 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1560 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1563 /* Table of XLFD width names. This table must be sorted by width
1564 names in ascending order. */
1566 static struct table_entry swidth_table
[] =
1568 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1569 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1570 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1571 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1572 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1573 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1574 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1575 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1576 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1577 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1578 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1579 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1580 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1581 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1582 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1585 /* Structure used to hold the result of splitting font names in XLFD
1586 format into their fields. */
1590 /* The original name which is modified destructively by
1591 split_font_name. The pointer is kept here to be able to free it
1592 if it was allocated from the heap. */
1595 /* Font name fields. Each vector element points into `name' above.
1596 Fields are NUL-terminated. */
1597 char *fields
[XLFD_LAST
];
1599 /* Numeric values for those fields that interest us. See
1600 split_font_name for which these are. */
1601 int numeric
[XLFD_LAST
];
1604 /* The frame in effect when sorting font names. Set temporarily in
1605 sort_fonts so that it is available in font comparison functions. */
1607 static struct frame
*font_frame
;
1609 /* Order by which font selection chooses fonts. The default values
1610 mean `first, find a best match for the font width, then for the
1611 font height, then for weight, then for slant.' This variable can be
1612 set via set-face-font-sort-order. */
1614 static int font_sort_order
[4];
1617 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1618 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1619 is a pointer to the matching table entry or null if no table entry
1622 static struct table_entry
*
1623 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1624 struct table_entry
*table
;
1626 struct font_name
*font
;
1629 /* Function split_font_name converts fields to lower-case, so there
1630 is no need to use xstrlwr or xstricmp here. */
1631 char *s
= font
->fields
[field_index
];
1632 int low
, mid
, high
, cmp
;
1639 mid
= (low
+ high
) / 2;
1640 cmp
= strcmp (table
[mid
].name
, s
);
1654 /* Return a numeric representation for font name field
1655 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1656 has DIM entries. Value is the numeric value found or DFLT if no
1657 table entry matches. This function is used to translate weight,
1658 slant, and swidth names of XLFD font names to numeric values. */
1661 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1662 struct table_entry
*table
;
1664 struct font_name
*font
;
1668 struct table_entry
*p
;
1669 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1670 return p
? p
->numeric
: dflt
;
1674 /* Return a symbolic representation for font name field
1675 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1676 has DIM entries. Value is the symbolic value found or DFLT if no
1677 table entry matches. This function is used to translate weight,
1678 slant, and swidth names of XLFD font names to symbols. */
1680 static INLINE Lisp_Object
1681 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1682 struct table_entry
*table
;
1684 struct font_name
*font
;
1688 struct table_entry
*p
;
1689 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1690 return p
? *p
->symbol
: dflt
;
1694 /* Return a numeric value for the slant of the font given by FONT. */
1697 xlfd_numeric_slant (font
)
1698 struct font_name
*font
;
1700 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1701 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1705 /* Return a symbol representing the weight of the font given by FONT. */
1707 static INLINE Lisp_Object
1708 xlfd_symbolic_slant (font
)
1709 struct font_name
*font
;
1711 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1712 font
, XLFD_SLANT
, Qnormal
);
1716 /* Return a numeric value for the weight of the font given by FONT. */
1719 xlfd_numeric_weight (font
)
1720 struct font_name
*font
;
1722 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1723 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1727 /* Return a symbol representing the slant of the font given by FONT. */
1729 static INLINE Lisp_Object
1730 xlfd_symbolic_weight (font
)
1731 struct font_name
*font
;
1733 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1734 font
, XLFD_WEIGHT
, Qnormal
);
1738 /* Return a numeric value for the swidth of the font whose XLFD font
1739 name fields are found in FONT. */
1742 xlfd_numeric_swidth (font
)
1743 struct font_name
*font
;
1745 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1746 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1750 /* Return a symbolic value for the swidth of FONT. */
1752 static INLINE Lisp_Object
1753 xlfd_symbolic_swidth (font
)
1754 struct font_name
*font
;
1756 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1757 font
, XLFD_SWIDTH
, Qnormal
);
1761 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1762 entries. Value is a pointer to the matching table entry or null if
1763 no element of TABLE contains SYMBOL. */
1765 static struct table_entry
*
1766 face_value (table
, dim
, symbol
)
1767 struct table_entry
*table
;
1773 xassert (SYMBOLP (symbol
));
1775 for (i
= 0; i
< dim
; ++i
)
1776 if (EQ (*table
[i
].symbol
, symbol
))
1779 return i
< dim
? table
+ i
: NULL
;
1783 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1784 entries. Value is -1 if SYMBOL is not found in TABLE. */
1787 face_numeric_value (table
, dim
, symbol
)
1788 struct table_entry
*table
;
1792 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1793 return p
? p
->numeric
: -1;
1797 /* Return a numeric value representing the weight specified by Lisp
1798 symbol WEIGHT. Value is one of the enumerators of enum
1802 face_numeric_weight (weight
)
1805 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1809 /* Return a numeric value representing the slant specified by Lisp
1810 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1813 face_numeric_slant (slant
)
1816 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1820 /* Return a numeric value representing the swidth specified by Lisp
1821 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1824 face_numeric_swidth (width
)
1827 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1831 #ifdef HAVE_X_WINDOWS
1833 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1837 struct font_name
*font
;
1839 /* Function split_font_name converts fields to lower-case, so there
1840 is no need to use tolower here. */
1841 return *font
->fields
[XLFD_SPACING
] != 'p';
1845 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1847 The actual height of the font when displayed on F depends on the
1848 resolution of both the font and frame. For example, a 10pt font
1849 designed for a 100dpi display will display larger than 10pt on a
1850 75dpi display. (It's not unusual to use fonts not designed for the
1851 display one is using. For example, some intlfonts are available in
1852 72dpi versions, only.)
1854 Value is the real point size of FONT on frame F, or 0 if it cannot
1858 xlfd_point_size (f
, font
)
1860 struct font_name
*font
;
1862 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1863 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1864 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1867 if (font_resy
== 0 || font_pt
== 0)
1870 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1876 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1877 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1878 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1879 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1880 zero if the font name doesn't have the format we expect. The
1881 expected format is a font name that starts with a `-' and has
1882 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1883 forms of font names where certain field contents are enclosed in
1884 square brackets. We don't support that, for now. */
1887 split_font_name (f
, font
, numeric_p
)
1889 struct font_name
*font
;
1895 if (*font
->name
== '-')
1897 char *p
= xstrlwr (font
->name
) + 1;
1899 while (i
< XLFD_LAST
)
1901 font
->fields
[i
] = p
;
1904 while (*p
&& *p
!= '-')
1914 success_p
= i
== XLFD_LAST
;
1916 /* If requested, and font name was in the expected format,
1917 compute numeric values for some fields. */
1918 if (numeric_p
&& success_p
)
1920 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1921 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1922 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1923 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1924 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
1931 /* Build an XLFD font name from font name fields in FONT. Value is a
1932 pointer to the font name, which is allocated via xmalloc. */
1935 build_font_name (font
)
1936 struct font_name
*font
;
1940 char *font_name
= (char *) xmalloc (size
);
1941 int total_length
= 0;
1943 for (i
= 0; i
< XLFD_LAST
; ++i
)
1945 /* Add 1 because of the leading `-'. */
1946 int len
= strlen (font
->fields
[i
]) + 1;
1948 /* Reallocate font_name if necessary. Add 1 for the final
1950 if (total_length
+ len
+ 1 >= size
)
1952 int new_size
= max (2 * size
, size
+ len
+ 1);
1953 int sz
= new_size
* sizeof *font_name
;
1954 font_name
= (char *) xrealloc (font_name
, sz
);
1958 font_name
[total_length
] = '-';
1959 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
1960 total_length
+= len
;
1963 font_name
[total_length
] = 0;
1968 /* Free an array FONTS of N font_name structures. This frees FONTS
1969 itself and all `name' fields in its elements. */
1972 free_font_names (fonts
, n
)
1973 struct font_name
*fonts
;
1977 xfree (fonts
[--n
].name
);
1982 /* Sort vector FONTS of font_name structures which contains NFONTS
1983 elements using qsort and comparison function CMPFN. F is the frame
1984 on which the fonts will be used. The global variable font_frame
1985 is temporarily set to F to make it available in CMPFN. */
1988 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
1990 struct font_name
*fonts
;
1992 int (*cmpfn
) P_ ((const void *, const void *));
1995 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2000 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2001 display in x_display_list. FONTS is a pointer to a vector of
2002 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2003 alternative patterns from Valternate_fontname_alist if no fonts are
2004 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2007 For all fonts found, set FONTS[i].name to the name of the font,
2008 allocated via xmalloc, and split font names into fields. Ignore
2009 fonts that we can't parse. Value is the number of fonts found.
2011 This is similar to x_list_fonts. The differences are:
2013 1. It avoids consing.
2014 2. It never calls XLoadQueryFont. */
2017 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2021 struct font_name
*fonts
;
2022 int nfonts
, try_alternatives_p
;
2023 int scalable_fonts_p
;
2025 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2029 /* Get the list of fonts matching PATTERN from the X server. */
2031 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2036 /* Make a copy of the font names we got from X, and
2037 split them into fields. */
2038 for (i
= j
= 0; i
< n
; ++i
)
2040 /* Make a copy of the font name. */
2041 fonts
[j
].name
= xstrdup (names
[i
]);
2043 /* Ignore fonts having a name that we can't parse. */
2044 if (!split_font_name (f
, fonts
+ j
, 1))
2045 xfree (fonts
[j
].name
);
2046 else if (font_scalable_p (fonts
+ j
))
2049 if (!scalable_fonts_p
2050 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2051 xfree (fonts
[j
].name
);
2054 #else /* !SCALABLE_FONTS */
2055 /* Always ignore scalable fonts. */
2056 xfree (fonts
[j
].name
);
2057 #endif /* !SCALABLE_FONTS */
2065 /* Free font names. */
2067 XFreeFontNames (names
);
2072 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2073 if (n
== 0 && try_alternatives_p
)
2075 Lisp_Object list
= Valternate_fontname_alist
;
2077 while (CONSP (list
))
2079 Lisp_Object entry
= XCAR (list
);
2081 && STRINGP (XCAR (entry
))
2082 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2089 Lisp_Object patterns
= XCAR (list
);
2092 while (CONSP (patterns
)
2093 /* If list is screwed up, give up. */
2094 && (name
= XCAR (patterns
),
2096 /* Ignore patterns equal to PATTERN because we tried that
2097 already with no success. */
2098 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2099 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2103 patterns
= XCDR (patterns
);
2111 /* Determine the first font matching PATTERN on frame F. Return in
2112 *FONT the matching font name, split into fields. Value is non-zero
2113 if a match was found. */
2116 first_font_matching (f
, pattern
, font
)
2119 struct font_name
*font
;
2122 struct font_name
*fonts
;
2124 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2125 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2129 bcopy (&fonts
[0], font
, sizeof *font
);
2131 fonts
[0].name
= NULL
;
2132 free_font_names (fonts
, nfonts
);
2139 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2140 using comparison function CMPFN. Value is the number of fonts
2141 found. If value is non-zero, *FONTS is set to a vector of
2142 font_name structures allocated from the heap containing matching
2143 fonts. Each element of *FONTS contains a name member that is also
2144 allocated from the heap. Font names in these structures are split
2145 into fields. Use free_font_names to free such an array. */
2148 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2151 int (*cmpfn
) P_ ((const void *, const void *));
2152 struct font_name
**fonts
;
2156 /* Get the list of fonts matching pattern. 100 should suffice. */
2157 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2158 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2159 nfonts
= XFASTINT (Vfont_list_limit
);
2161 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2163 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2165 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2168 /* Sort the resulting array and return it in *FONTS. If no
2169 fonts were found, make sure to set *FONTS to null. */
2171 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2182 /* Compare two font_name structures *A and *B. Value is analogous to
2183 strcmp. Sort order is given by the global variable
2184 font_sort_order. Font names are sorted so that, everything else
2185 being equal, fonts with a resolution closer to that of the frame on
2186 which they are used are listed first. The global variable
2187 font_frame is the frame on which we operate. */
2190 cmp_font_names (a
, b
)
2193 struct font_name
*x
= (struct font_name
*) a
;
2194 struct font_name
*y
= (struct font_name
*) b
;
2197 /* All strings have been converted to lower-case by split_font_name,
2198 so we can use strcmp here. */
2199 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2204 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2206 int j
= font_sort_order
[i
];
2207 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2212 /* Everything else being equal, we prefer fonts with an
2213 y-resolution closer to that of the frame. */
2214 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2215 int x_resy
= x
->numeric
[XLFD_RESY
];
2216 int y_resy
= y
->numeric
[XLFD_RESY
];
2217 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2225 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2226 is non-null list fonts matching that pattern. Otherwise, if
2227 REGISTRY_AND_ENCODING is non-null return only fonts with that
2228 registry and encoding, otherwise return fonts of any registry and
2229 encoding. Set *FONTS to a vector of font_name structures allocated
2230 from the heap containing the fonts found. Value is the number of
2234 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2238 char *registry_and_encoding
;
2239 struct font_name
**fonts
;
2241 if (pattern
== NULL
)
2246 if (registry_and_encoding
== NULL
)
2247 registry_and_encoding
= "*";
2249 pattern
= (char *) alloca (strlen (family
)
2250 + strlen (registry_and_encoding
)
2252 if (index (family
, '-'))
2253 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2255 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2258 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2262 /* Remove elements from LIST whose cars are `equal'. Called from
2263 x-family-fonts and x-font-family-list to remove duplicate font
2267 remove_duplicates (list
)
2270 Lisp_Object tail
= list
;
2272 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2274 Lisp_Object next
= XCDR (tail
);
2275 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2276 XCDR (tail
) = XCDR (next
);
2283 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2284 "Return a list of available fonts of family FAMILY on FRAME.\n\
2285 If FAMILY is omitted or nil, list all families.\n\
2286 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2288 If FRAME is omitted or nil, use the selected frame.\n\
2289 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2290 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2291 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2292 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2293 width, weight and slant of the font. These symbols are the same as for\n\
2294 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2295 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2296 giving the registry and encoding of the font.\n\
2297 The result list is sorted according to the current setting of\n\
2298 the face font sort order.")
2300 Lisp_Object family
, frame
;
2302 struct frame
*f
= check_x_frame (frame
);
2303 struct font_name
*fonts
;
2306 struct gcpro gcpro1
;
2307 char *family_pattern
;
2310 family_pattern
= "*";
2313 CHECK_STRING (family
, 1);
2314 family_pattern
= LSTRDUPA (family
);
2319 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2320 for (i
= nfonts
- 1; i
>= 0; --i
)
2322 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2325 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2327 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2328 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2329 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2330 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2331 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2332 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2333 tem
= build_font_name (fonts
+ i
);
2334 ASET (v
, 6, build_string (tem
));
2335 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2336 fonts
[i
].fields
[XLFD_ENCODING
]);
2337 ASET (v
, 7, build_string (tem
));
2340 result
= Fcons (v
, result
);
2345 remove_duplicates (result
);
2346 free_font_names (fonts
, nfonts
);
2352 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2354 "Return a list of available font families on FRAME.\n\
2355 If FRAME is omitted or nil, use the selected frame.\n\
2356 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2357 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2362 struct frame
*f
= check_x_frame (frame
);
2364 struct font_name
*fonts
;
2366 struct gcpro gcpro1
;
2367 int count
= specpdl_ptr
- specpdl
;
2370 /* Let's consider all fonts. Increase the limit for matching
2371 fonts until we have them all. */
2374 specbind (intern ("font-list-limit"), make_number (limit
));
2375 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2377 if (nfonts
== limit
)
2379 free_font_names (fonts
, nfonts
);
2388 for (i
= nfonts
- 1; i
>= 0; --i
)
2389 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2390 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2393 remove_duplicates (result
);
2394 free_font_names (fonts
, nfonts
);
2396 return unbind_to (count
, result
);
2400 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2401 "Return a list of the names of available fonts matching PATTERN.\n\
2402 If optional arguments FACE and FRAME are specified, return only fonts\n\
2403 the same size as FACE on FRAME.\n\
2404 PATTERN is a string, perhaps with wildcard characters;\n\
2405 the * character matches any substring, and\n\
2406 the ? character matches any single character.\n\
2407 PATTERN is case-insensitive.\n\
2408 FACE is a face name--a symbol.\n\
2410 The return value is a list of strings, suitable as arguments to\n\
2413 Fonts Emacs can't use may or may not be excluded\n\
2414 even if they match PATTERN and FACE.\n\
2415 The optional fourth argument MAXIMUM sets a limit on how many\n\
2416 fonts to match. The first MAXIMUM fonts are reported.\n\
2417 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2418 occupied by a character of a font. In that case, return only fonts\n\
2419 the WIDTH times as wide as FACE on FRAME.")
2420 (pattern
, face
, frame
, maximum
, width
)
2421 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2428 CHECK_STRING (pattern
, 0);
2434 CHECK_NATNUM (maximum
, 0);
2435 maxnames
= XINT (maximum
);
2439 CHECK_NUMBER (width
, 4);
2441 /* We can't simply call check_x_frame because this function may be
2442 called before any frame is created. */
2443 f
= frame_or_selected_frame (frame
, 2);
2446 /* Perhaps we have not yet created any frame. */
2451 /* Determine the width standard for comparison with the fonts we find. */
2457 /* This is of limited utility since it works with character
2458 widths. Keep it for compatibility. --gerd. */
2459 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2460 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2463 size
= face
->font
->max_bounds
.width
;
2465 size
= FRAME_FONT (f
)->max_bounds
.width
;
2468 size
*= XINT (width
);
2472 Lisp_Object args
[2];
2474 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2476 /* We don't have to check fontsets. */
2478 args
[1] = list_fontsets (f
, pattern
, size
);
2479 return Fnconc (2, args
);
2483 #endif /* HAVE_X_WINDOWS */
2487 /***********************************************************************
2489 ***********************************************************************/
2491 /* Access face attributes of face FACE, a Lisp vector. */
2493 #define LFACE_FAMILY(LFACE) \
2494 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2495 #define LFACE_HEIGHT(LFACE) \
2496 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2497 #define LFACE_WEIGHT(LFACE) \
2498 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2499 #define LFACE_SLANT(LFACE) \
2500 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2501 #define LFACE_UNDERLINE(LFACE) \
2502 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2503 #define LFACE_INVERSE(LFACE) \
2504 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2505 #define LFACE_FOREGROUND(LFACE) \
2506 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2507 #define LFACE_BACKGROUND(LFACE) \
2508 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2509 #define LFACE_STIPPLE(LFACE) \
2510 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2511 #define LFACE_SWIDTH(LFACE) \
2512 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2513 #define LFACE_OVERLINE(LFACE) \
2514 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2515 #define LFACE_STRIKE_THROUGH(LFACE) \
2516 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2517 #define LFACE_BOX(LFACE) \
2518 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2520 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2521 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2523 #define LFACEP(LFACE) \
2525 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2526 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2531 /* Check consistency of Lisp face attribute vector ATTRS. */
2534 check_lface_attrs (attrs
)
2537 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2538 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2539 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2540 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2541 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2542 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2543 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2544 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2545 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2546 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2547 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2548 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2549 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2550 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2551 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2552 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2553 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2554 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2555 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2556 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2557 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2558 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2559 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2560 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2561 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2562 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2563 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2564 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2565 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2566 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2567 #ifdef HAVE_WINDOW_SYSTEM
2568 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2569 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2570 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2575 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2583 xassert (LFACEP (lface
));
2584 check_lface_attrs (XVECTOR (lface
)->contents
);
2588 #else /* GLYPH_DEBUG == 0 */
2590 #define check_lface_attrs(attrs) (void) 0
2591 #define check_lface(lface) (void) 0
2593 #endif /* GLYPH_DEBUG == 0 */
2596 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2597 to make it a symvol. If FACE_NAME is an alias for another face,
2598 return that face's name. */
2601 resolve_face_name (face_name
)
2602 Lisp_Object face_name
;
2604 Lisp_Object aliased
;
2606 if (STRINGP (face_name
))
2607 face_name
= intern (XSTRING (face_name
)->data
);
2611 aliased
= Fget (face_name
, Qface_alias
);
2615 face_name
= aliased
;
2622 /* Return the face definition of FACE_NAME on frame F. F null means
2623 return the global definition. FACE_NAME may be a string or a
2624 symbol (apparently Emacs 20.2 allows strings as face names in face
2625 text properties; ediff uses that). If FACE_NAME is an alias for
2626 another face, return that face's definition. If SIGNAL_P is
2627 non-zero, signal an error if FACE_NAME is not a valid face name.
2628 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2631 static INLINE Lisp_Object
2632 lface_from_face_name (f
, face_name
, signal_p
)
2634 Lisp_Object face_name
;
2639 face_name
= resolve_face_name (face_name
);
2642 lface
= assq_no_quit (face_name
, f
->face_alist
);
2644 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2647 lface
= XCDR (lface
);
2649 signal_error ("Invalid face", face_name
);
2651 check_lface (lface
);
2656 /* Get face attributes of face FACE_NAME from frame-local faces on
2657 frame F. Store the resulting attributes in ATTRS which must point
2658 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2659 is non-zero, signal an error if FACE_NAME does not name a face.
2660 Otherwise, value is zero if FACE_NAME is not a face. */
2663 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2665 Lisp_Object face_name
;
2672 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2675 bcopy (XVECTOR (lface
)->contents
, attrs
,
2676 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2686 /* Non-zero if all attributes in face attribute vector ATTRS are
2687 specified, i.e. are non-nil. */
2690 lface_fully_specified_p (attrs
)
2695 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2696 if (UNSPECIFIEDP (attrs
[i
]))
2699 return i
== LFACE_VECTOR_SIZE
;
2703 #ifdef HAVE_X_WINDOWS
2705 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2706 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2707 LFACE. Ignore fields of FONT_NAME containing wildcards. Value is
2708 zero if not successful because FONT_NAME was not in a valid format.
2709 A valid format is one that is suitable for split_font_name, see the
2713 set_lface_from_font_name (f
, lface
, font_name
, force_p
)
2719 struct font_name font
;
2722 int free_font_name_p
= 0;
2724 /* If FONT_NAME contains wildcards, use the first matching font. */
2725 if (index (font_name
, '*') || index (font_name
, '?'))
2727 if (!first_font_matching (f
, font_name
, &font
))
2729 free_font_name_p
= 1;
2733 font
.name
= STRDUPA (font_name
);
2734 if (!split_font_name (f
, &font
, 1))
2736 /* The font name may be something like `6x13'. Make
2737 sure we use the full name. */
2738 struct font_info
*font_info
;
2741 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2742 CHARSET_ASCII
, font_name
, -1);
2748 font
.name
= STRDUPA (font_info
->full_name
);
2749 split_font_name (f
, &font
, 1);
2752 /* FONT_NAME should not be a fontset name, here. */
2753 xassert (xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0);
2756 /* Set attributes only if unspecified, otherwise face defaults for
2757 new frames would never take effect. */
2759 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2761 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2762 + strlen (font
.fields
[XLFD_FOUNDRY
])
2764 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2765 font
.fields
[XLFD_FAMILY
]);
2766 LFACE_FAMILY (lface
) = build_string (buffer
);
2769 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2771 pt
= xlfd_point_size (f
, &font
);
2773 LFACE_HEIGHT (lface
) = make_number (pt
);
2776 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2777 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2779 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2780 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2782 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2783 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2785 if (free_font_name_p
)
2791 #endif /* HAVE_X_WINDOWS */
2794 /* Merge two Lisp face attribute vectors FROM and TO and store the
2795 resulting attributes in TO. Every non-nil attribute of FROM
2796 overrides the corresponding attribute of TO. */
2799 merge_face_vectors (from
, to
)
2800 Lisp_Object
*from
, *to
;
2803 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2804 if (!UNSPECIFIEDP (from
[i
]))
2809 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2810 is a face property, determine the resulting face attributes on
2811 frame F, and store them in TO. PROP may be a single face
2812 specification or a list of such specifications. Each face
2813 specification can be
2815 1. A symbol or string naming a Lisp face.
2817 2. A property list of the form (KEYWORD VALUE ...) where each
2818 KEYWORD is a face attribute name, and value is an appropriate value
2821 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2822 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2823 for compatibility with 20.2.
2825 Face specifications earlier in lists take precedence over later
2829 merge_face_vector_with_property (f
, to
, prop
)
2836 Lisp_Object first
= XCAR (prop
);
2838 if (EQ (first
, Qforeground_color
)
2839 || EQ (first
, Qbackground_color
))
2841 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2842 . COLOR). COLOR must be a string. */
2843 Lisp_Object color_name
= XCDR (prop
);
2844 Lisp_Object color
= first
;
2846 if (STRINGP (color_name
))
2848 if (EQ (color
, Qforeground_color
))
2849 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2851 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2854 add_to_log ("Invalid face color", color_name
, Qnil
);
2856 else if (SYMBOLP (first
)
2857 && *XSYMBOL (first
)->name
->data
== ':')
2859 /* Assume this is the property list form. */
2860 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2862 Lisp_Object keyword
= XCAR (prop
);
2863 Lisp_Object value
= XCAR (XCDR (prop
));
2865 if (EQ (keyword
, QCfamily
))
2867 if (STRINGP (value
))
2868 to
[LFACE_FAMILY_INDEX
] = value
;
2870 add_to_log ("Illegal face font family", value
, Qnil
);
2872 else if (EQ (keyword
, QCheight
))
2874 if (INTEGERP (value
))
2875 to
[LFACE_HEIGHT_INDEX
] = value
;
2877 add_to_log ("Illegal face font height", value
, Qnil
);
2879 else if (EQ (keyword
, QCweight
))
2882 && face_numeric_weight (value
) >= 0)
2883 to
[LFACE_WEIGHT_INDEX
] = value
;
2885 add_to_log ("Illegal face weight", value
, Qnil
);
2887 else if (EQ (keyword
, QCslant
))
2890 && face_numeric_slant (value
) >= 0)
2891 to
[LFACE_SLANT_INDEX
] = value
;
2893 add_to_log ("Illegal face slant", value
, Qnil
);
2895 else if (EQ (keyword
, QCunderline
))
2900 to
[LFACE_UNDERLINE_INDEX
] = value
;
2902 add_to_log ("Illegal face underline", value
, Qnil
);
2904 else if (EQ (keyword
, QCoverline
))
2909 to
[LFACE_OVERLINE_INDEX
] = value
;
2911 add_to_log ("Illegal face overline", value
, Qnil
);
2913 else if (EQ (keyword
, QCstrike_through
))
2918 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2920 add_to_log ("Illegal face strike-through", value
, Qnil
);
2922 else if (EQ (keyword
, QCbox
))
2925 value
= make_number (1);
2926 if (INTEGERP (value
)
2930 to
[LFACE_BOX_INDEX
] = value
;
2932 add_to_log ("Illegal face box", value
, Qnil
);
2934 else if (EQ (keyword
, QCinverse_video
)
2935 || EQ (keyword
, QCreverse_video
))
2937 if (EQ (value
, Qt
) || NILP (value
))
2938 to
[LFACE_INVERSE_INDEX
] = value
;
2940 add_to_log ("Illegal face inverse-video", value
, Qnil
);
2942 else if (EQ (keyword
, QCforeground
))
2944 if (STRINGP (value
))
2945 to
[LFACE_FOREGROUND_INDEX
] = value
;
2947 add_to_log ("Illegal face foreground", value
, Qnil
);
2949 else if (EQ (keyword
, QCbackground
))
2951 if (STRINGP (value
))
2952 to
[LFACE_BACKGROUND_INDEX
] = value
;
2954 add_to_log ("Illegal face background", value
, Qnil
);
2956 else if (EQ (keyword
, QCstipple
))
2958 #ifdef HAVE_X_WINDOWS
2959 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2960 if (!NILP (pixmap_p
))
2961 to
[LFACE_STIPPLE_INDEX
] = value
;
2963 add_to_log ("Illegal face stipple", value
, Qnil
);
2966 else if (EQ (keyword
, QCwidth
))
2969 && face_numeric_swidth (value
) >= 0)
2970 to
[LFACE_SWIDTH_INDEX
] = value
;
2972 add_to_log ("Illegal face width", value
, Qnil
);
2975 add_to_log ("Invalid attribute %s in face property",
2978 prop
= XCDR (XCDR (prop
));
2983 /* This is a list of face specs. Specifications at the
2984 beginning of the list take precedence over later
2985 specifications, so we have to merge starting with the
2986 last specification. */
2987 Lisp_Object next
= XCDR (prop
);
2989 merge_face_vector_with_property (f
, to
, next
);
2990 merge_face_vector_with_property (f
, to
, first
);
2995 /* PROP ought to be a face name. */
2996 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
2998 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3000 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3005 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3006 Sinternal_make_lisp_face
, 1, 2, 0,
3007 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3008 If FACE was not known as a face before, create a new one.\n\
3009 If optional argument FRAME is specified, make a frame-local face\n\
3010 for that frame. Otherwise operate on the global face definition.\n\
3011 Value is a vector of face attributes.")
3013 Lisp_Object face
, frame
;
3015 Lisp_Object global_lface
, lface
;
3019 CHECK_SYMBOL (face
, 0);
3020 global_lface
= lface_from_face_name (NULL
, face
, 0);
3024 CHECK_LIVE_FRAME (frame
, 1);
3026 lface
= lface_from_face_name (f
, face
, 0);
3029 f
= NULL
, lface
= Qnil
;
3031 /* Add a global definition if there is none. */
3032 if (NILP (global_lface
))
3034 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3036 XVECTOR (global_lface
)->contents
[0] = Qface
;
3037 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3038 Vface_new_frame_defaults
);
3040 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3041 face id to Lisp face is given by the vector lface_id_to_name.
3042 The mapping from Lisp face to Lisp face id is given by the
3043 property `face' of the Lisp face name. */
3044 if (next_lface_id
== lface_id_to_name_size
)
3046 int new_size
= max (50, 2 * lface_id_to_name_size
);
3047 int sz
= new_size
* sizeof *lface_id_to_name
;
3048 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3049 lface_id_to_name_size
= new_size
;
3052 lface_id_to_name
[next_lface_id
] = face
;
3053 Fput (face
, Qface
, make_number (next_lface_id
));
3057 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3058 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3060 /* Add a frame-local definition. */
3065 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3067 XVECTOR (lface
)->contents
[0] = Qface
;
3068 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3071 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3072 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3075 lface
= global_lface
;
3077 xassert (LFACEP (lface
));
3078 check_lface (lface
);
3083 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3084 Sinternal_lisp_face_p
, 1, 2, 0,
3085 "Return non-nil if FACE names a face.\n\
3086 If optional second parameter FRAME is non-nil, check for the\n\
3087 existence of a frame-local face with name FACE on that frame.\n\
3088 Otherwise check for the existence of a global face.")
3090 Lisp_Object face
, frame
;
3096 CHECK_LIVE_FRAME (frame
, 1);
3097 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3100 lface
= lface_from_face_name (NULL
, face
, 0);
3106 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3107 Sinternal_copy_lisp_face
, 4, 4, 0,
3108 "Copy face FROM to TO.\n\
3109 If FRAME it t, copy the global face definition of FROM to the\n\
3110 global face definition of TO. Otherwise, copy the frame-local\n\
3111 definition of FROM on FRAME to the frame-local definition of TO\n\
3112 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3115 (from
, to
, frame
, new_frame
)
3116 Lisp_Object from
, to
, frame
, new_frame
;
3118 Lisp_Object lface
, copy
;
3120 CHECK_SYMBOL (from
, 0);
3121 CHECK_SYMBOL (to
, 1);
3122 if (NILP (new_frame
))
3127 /* Copy global definition of FROM. We don't make copies of
3128 strings etc. because 20.2 didn't do it either. */
3129 lface
= lface_from_face_name (NULL
, from
, 1);
3130 copy
= Finternal_make_lisp_face (to
, Qnil
);
3134 /* Copy frame-local definition of FROM. */
3135 CHECK_LIVE_FRAME (frame
, 2);
3136 CHECK_LIVE_FRAME (new_frame
, 3);
3137 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3138 copy
= Finternal_make_lisp_face (to
, new_frame
);
3141 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3142 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3148 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3149 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3150 "Set attribute ATTR of FACE to VALUE.\n\
3151 If optional argument FRAME is given, set the face attribute of face FACE\n\
3152 on that frame. If FRAME is t, set the attribute of the default for face\n\
3153 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3155 (face
, attr
, value
, frame
)
3156 Lisp_Object face
, attr
, value
, frame
;
3159 Lisp_Object old_value
= Qnil
;
3160 int font_related_attr_p
= 0;
3162 CHECK_SYMBOL (face
, 0);
3163 CHECK_SYMBOL (attr
, 1);
3165 face
= resolve_face_name (face
);
3167 /* Set lface to the Lisp attribute vector of FACE. */
3169 lface
= lface_from_face_name (NULL
, face
, 1);
3173 frame
= selected_frame
;
3175 CHECK_LIVE_FRAME (frame
, 3);
3176 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3178 /* If a frame-local face doesn't exist yet, create one. */
3180 lface
= Finternal_make_lisp_face (face
, frame
);
3183 if (EQ (attr
, QCfamily
))
3185 if (!UNSPECIFIEDP (value
))
3187 CHECK_STRING (value
, 3);
3188 if (XSTRING (value
)->size
== 0)
3189 signal_error ("Invalid face family", value
);
3191 old_value
= LFACE_FAMILY (lface
);
3192 LFACE_FAMILY (lface
) = value
;
3193 font_related_attr_p
= 1;
3195 else if (EQ (attr
, QCheight
))
3197 if (!UNSPECIFIEDP (value
))
3199 CHECK_NUMBER (value
, 3);
3200 if (XINT (value
) <= 0)
3201 signal_error ("Invalid face height", value
);
3203 old_value
= LFACE_HEIGHT (lface
);
3204 LFACE_HEIGHT (lface
) = value
;
3205 font_related_attr_p
= 1;
3207 else if (EQ (attr
, QCweight
))
3209 if (!UNSPECIFIEDP (value
))
3211 CHECK_SYMBOL (value
, 3);
3212 if (face_numeric_weight (value
) < 0)
3213 signal_error ("Invalid face weight", value
);
3215 old_value
= LFACE_WEIGHT (lface
);
3216 LFACE_WEIGHT (lface
) = value
;
3217 font_related_attr_p
= 1;
3219 else if (EQ (attr
, QCslant
))
3221 if (!UNSPECIFIEDP (value
))
3223 CHECK_SYMBOL (value
, 3);
3224 if (face_numeric_slant (value
) < 0)
3225 signal_error ("Invalid face slant", value
);
3227 old_value
= LFACE_SLANT (lface
);
3228 LFACE_SLANT (lface
) = value
;
3229 font_related_attr_p
= 1;
3231 else if (EQ (attr
, QCunderline
))
3233 if (!UNSPECIFIEDP (value
))
3234 if ((SYMBOLP (value
)
3236 && !EQ (value
, Qnil
))
3237 /* Underline color. */
3239 && XSTRING (value
)->size
== 0))
3240 signal_error ("Invalid face underline", value
);
3242 old_value
= LFACE_UNDERLINE (lface
);
3243 LFACE_UNDERLINE (lface
) = value
;
3245 else if (EQ (attr
, QCoverline
))
3247 if (!UNSPECIFIEDP (value
))
3248 if ((SYMBOLP (value
)
3250 && !EQ (value
, Qnil
))
3251 /* Overline color. */
3253 && XSTRING (value
)->size
== 0))
3254 signal_error ("Invalid face overline", value
);
3256 old_value
= LFACE_OVERLINE (lface
);
3257 LFACE_OVERLINE (lface
) = value
;
3259 else if (EQ (attr
, QCstrike_through
))
3261 if (!UNSPECIFIEDP (value
))
3262 if ((SYMBOLP (value
)
3264 && !EQ (value
, Qnil
))
3265 /* Strike-through color. */
3267 && XSTRING (value
)->size
== 0))
3268 signal_error ("Invalid face strike-through", value
);
3270 old_value
= LFACE_STRIKE_THROUGH (lface
);
3271 LFACE_STRIKE_THROUGH (lface
) = value
;
3273 else if (EQ (attr
, QCbox
))
3277 /* Allow t meaning a simple box of width 1 in foreground color
3280 value
= make_number (1);
3282 if (UNSPECIFIEDP (value
))
3284 else if (NILP (value
))
3286 else if (INTEGERP (value
))
3287 valid_p
= XINT (value
) > 0;
3288 else if (STRINGP (value
))
3289 valid_p
= XSTRING (value
)->size
> 0;
3290 else if (CONSP (value
))
3306 if (EQ (k
, QCline_width
))
3308 if (!INTEGERP (v
) || XINT (v
) <= 0)
3311 else if (EQ (k
, QCcolor
))
3313 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3316 else if (EQ (k
, QCstyle
))
3318 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3325 valid_p
= NILP (tem
);
3331 signal_error ("Invalid face box", value
);
3333 old_value
= LFACE_BOX (lface
);
3334 LFACE_BOX (lface
) = value
;
3336 else if (EQ (attr
, QCinverse_video
)
3337 || EQ (attr
, QCreverse_video
))
3339 if (!UNSPECIFIEDP (value
))
3341 CHECK_SYMBOL (value
, 3);
3342 if (!EQ (value
, Qt
) && !NILP (value
))
3343 signal_error ("Invalid inverse-video face attribute value", value
);
3345 old_value
= LFACE_INVERSE (lface
);
3346 LFACE_INVERSE (lface
) = value
;
3348 else if (EQ (attr
, QCforeground
))
3350 if (!UNSPECIFIEDP (value
))
3352 /* Don't check for valid color names here because it depends
3353 on the frame (display) whether the color will be valid
3354 when the face is realized. */
3355 CHECK_STRING (value
, 3);
3356 if (XSTRING (value
)->size
== 0)
3357 signal_error ("Empty foreground color value", value
);
3359 old_value
= LFACE_FOREGROUND (lface
);
3360 LFACE_FOREGROUND (lface
) = value
;
3362 else if (EQ (attr
, QCbackground
))
3364 if (!UNSPECIFIEDP (value
))
3366 /* Don't check for valid color names here because it depends
3367 on the frame (display) whether the color will be valid
3368 when the face is realized. */
3369 CHECK_STRING (value
, 3);
3370 if (XSTRING (value
)->size
== 0)
3371 signal_error ("Empty background color value", value
);
3373 old_value
= LFACE_BACKGROUND (lface
);
3374 LFACE_BACKGROUND (lface
) = value
;
3376 else if (EQ (attr
, QCstipple
))
3378 #ifdef HAVE_X_WINDOWS
3379 if (!UNSPECIFIEDP (value
)
3381 && NILP (Fbitmap_spec_p (value
)))
3382 signal_error ("Invalid stipple attribute", value
);
3383 old_value
= LFACE_STIPPLE (lface
);
3384 LFACE_STIPPLE (lface
) = value
;
3385 #endif /* HAVE_X_WINDOWS */
3387 else if (EQ (attr
, QCwidth
))
3389 if (!UNSPECIFIEDP (value
))
3391 CHECK_SYMBOL (value
, 3);
3392 if (face_numeric_swidth (value
) < 0)
3393 signal_error ("Invalid face width", value
);
3395 old_value
= LFACE_SWIDTH (lface
);
3396 LFACE_SWIDTH (lface
) = value
;
3397 font_related_attr_p
= 1;
3399 else if (EQ (attr
, QCfont
))
3401 #ifdef HAVE_X_WINDOWS
3402 /* Set font-related attributes of the Lisp face from an
3406 CHECK_STRING (value
, 3);
3408 f
= SELECTED_FRAME ();
3410 f
= check_x_frame (frame
);
3412 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1))
3413 signal_error ("Invalid font name", value
);
3415 font_related_attr_p
= 1;
3416 #endif /* HAVE_X_WINDOWS */
3418 else if (EQ (attr
, QCbold
))
3420 old_value
= LFACE_WEIGHT (lface
);
3421 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3422 font_related_attr_p
= 1;
3424 else if (EQ (attr
, QCitalic
))
3426 old_value
= LFACE_SLANT (lface
);
3427 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3428 font_related_attr_p
= 1;
3431 signal_error ("Invalid face attribute name", attr
);
3433 /* Changing a named face means that all realized faces depending on
3434 that face are invalid. Since we cannot tell which realized faces
3435 depend on the face, make sure they are all removed. This is done
3436 by incrementing face_change_count. The next call to
3437 init_iterator will then free realized faces. */
3439 && (EQ (attr
, QCfont
)
3440 || NILP (Fequal (old_value
, value
))))
3442 ++face_change_count
;
3443 ++windows_or_buffers_changed
;
3446 #ifdef HAVE_X_WINDOWS
3449 && !UNSPECIFIEDP (value
)
3450 && NILP (Fequal (old_value
, value
)))
3456 if (EQ (face
, Qdefault
))
3458 /* Changed font-related attributes of the `default' face are
3459 reflected in changed `font' frame parameters. */
3460 if (font_related_attr_p
3461 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3462 set_font_frame_param (frame
, lface
);
3463 else if (EQ (attr
, QCforeground
))
3464 param
= Qforeground_color
;
3465 else if (EQ (attr
, QCbackground
))
3466 param
= Qbackground_color
;
3468 else if (EQ (face
, Qscroll_bar
))
3470 /* Changing the colors of `scroll-bar' sets frame parameters
3471 `scroll-bar-foreground' and `scroll-bar-background'. */
3472 if (EQ (attr
, QCforeground
))
3473 param
= Qscroll_bar_foreground
;
3474 else if (EQ (attr
, QCbackground
))
3475 param
= Qscroll_bar_background
;
3477 else if (EQ (face
, Qborder
))
3479 /* Changing background color of `border' sets frame parameter
3481 if (EQ (attr
, QCbackground
))
3482 param
= Qborder_color
;
3484 else if (EQ (face
, Qcursor
))
3486 /* Changing background color of `cursor' sets frame parameter
3488 if (EQ (attr
, QCbackground
))
3489 param
= Qcursor_color
;
3491 else if (EQ (face
, Qmouse
))
3493 /* Changing background color of `mouse' sets frame parameter
3495 if (EQ (attr
, QCbackground
))
3496 param
= Qmouse_color
;
3499 if (SYMBOLP (param
))
3500 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3503 #endif /* HAVE_X_WINDOWS */
3509 #ifdef HAVE_X_WINDOWS
3511 /* Set the `font' frame parameter of FRAME according to `default' face
3512 attributes LFACE. */
3515 set_font_frame_param (frame
, lface
)
3516 Lisp_Object frame
, lface
;
3518 struct frame
*f
= XFRAME (frame
);
3519 Lisp_Object frame_font
;
3523 /* Get FRAME's font parameter. */
3524 frame_font
= Fassq (Qfont
, f
->param_alist
);
3525 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3526 frame_font
= XCDR (frame_font
);
3528 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3531 /* Frame parameter is a fontset name. Modify the fontset so
3532 that all its fonts reflect face attributes LFACE. */
3534 struct fontset_info
*fontset_info
;
3536 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3538 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3539 if (fontset_info
->fontname
[charset
])
3541 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3543 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3544 build_string (font
), frame
);
3550 /* Frame parameter is an X font name. I believe this can
3551 only happen in unibyte mode. */
3552 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3553 -1, Vface_default_registry
);
3556 store_frame_param (f
, Qfont
, build_string (font
));
3563 /* Update the corresponding face when frame parameter PARAM on frame F
3564 has been assigned the value NEW_VALUE. */
3567 update_face_from_frame_parameter (f
, param
, new_value
)
3569 Lisp_Object param
, new_value
;
3573 /* If there are no faces yet, give up. This is the case when called
3574 from Fx_create_frame, and we do the necessary things later in
3575 face-set-after-frame-defaults. */
3576 if (NILP (f
->face_alist
))
3579 if (EQ (param
, Qforeground_color
))
3581 lface
= lface_from_face_name (f
, Qdefault
, 1);
3582 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3583 ? new_value
: Qunspecified
);
3584 realize_basic_faces (f
);
3586 else if (EQ (param
, Qbackground_color
))
3590 /* Changing the background color might change the background
3591 mode, so that we have to load new defface specs. Call
3592 frame-update-face-colors to do that. */
3593 XSETFRAME (frame
, f
);
3594 call1 (Qframe_update_face_colors
, frame
);
3596 lface
= lface_from_face_name (f
, Qdefault
, 1);
3597 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3598 ? new_value
: Qunspecified
);
3599 realize_basic_faces (f
);
3601 if (EQ (param
, Qborder_color
))
3603 lface
= lface_from_face_name (f
, Qborder
, 1);
3604 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3605 ? new_value
: Qunspecified
);
3607 else if (EQ (param
, Qcursor_color
))
3609 lface
= lface_from_face_name (f
, Qcursor
, 1);
3610 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3611 ? new_value
: Qunspecified
);
3613 else if (EQ (param
, Qmouse_color
))
3615 lface
= lface_from_face_name (f
, Qmouse
, 1);
3616 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3617 ? new_value
: Qunspecified
);
3622 /* Get the value of X resource RESOURCE, class CLASS for the display
3623 of frame FRAME. This is here because ordinary `x-get-resource'
3624 doesn't take a frame argument. */
3626 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3627 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3628 (resource
, class, frame
)
3629 Lisp_Object resource
, class, frame
;
3632 CHECK_STRING (resource
, 0);
3633 CHECK_STRING (class, 1);
3634 CHECK_LIVE_FRAME (frame
, 2);
3636 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3637 resource
, class, Qnil
, Qnil
);
3643 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3644 If VALUE is "on" or "true", return t. If VALUE is "off" or
3645 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3646 error; if SIGNAL_P is zero, return 0. */
3649 face_boolean_x_resource_value (value
, signal_p
)
3653 Lisp_Object result
= make_number (0);
3655 xassert (STRINGP (value
));
3657 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3658 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3660 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3661 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3663 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3664 result
= Qunspecified
;
3666 signal_error ("Invalid face attribute value from X resource", value
);
3672 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3673 Finternal_set_lisp_face_attribute_from_resource
,
3674 Sinternal_set_lisp_face_attribute_from_resource
,
3676 (face
, attr
, value
, frame
)
3677 Lisp_Object face
, attr
, value
, frame
;
3679 CHECK_SYMBOL (face
, 0);
3680 CHECK_SYMBOL (attr
, 1);
3681 CHECK_STRING (value
, 2);
3683 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3684 value
= Qunspecified
;
3685 else if (EQ (attr
, QCheight
))
3687 value
= Fstring_to_number (value
, make_number (10));
3688 if (XINT (value
) <= 0)
3689 signal_error ("Invalid face height from X resource", value
);
3691 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3692 value
= face_boolean_x_resource_value (value
, 1);
3693 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3694 value
= intern (XSTRING (value
)->data
);
3695 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3696 value
= face_boolean_x_resource_value (value
, 1);
3697 else if (EQ (attr
, QCunderline
)
3698 || EQ (attr
, QCoverline
)
3699 || EQ (attr
, QCstrike_through
)
3700 || EQ (attr
, QCbox
))
3702 Lisp_Object boolean_value
;
3704 /* If the result of face_boolean_x_resource_value is t or nil,
3705 VALUE does NOT specify a color. */
3706 boolean_value
= face_boolean_x_resource_value (value
, 0);
3707 if (SYMBOLP (boolean_value
))
3708 value
= boolean_value
;
3711 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3716 /***********************************************************************
3718 ***********************************************************************/
3720 #ifdef USE_X_TOOLKIT
3722 /* Structure used to pass X resources to functions called via
3723 XtApplyToWidgets. */
3734 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3735 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3738 /* Set widget W's X resources from P which points to an x_resources
3739 structure. If W is a cascade button, apply resources to W's
3743 xm_apply_resources (w
, p
)
3748 struct x_resources
*res
= (struct x_resources
*) p
;
3750 XtSetValues (w
, res
->av
, res
->ac
);
3751 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3754 XtSetValues (submenu
, res
->av
, res
->ac
);
3755 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3760 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3761 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3764 1. Setting the XmNfontList resource leads to an infinite loop
3765 somewhere in LessTif. */
3768 xm_set_menu_resources_from_menu_face (f
, widget
)
3778 lface
= lface_from_face_name (f
, Qmenu
, 1);
3779 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3781 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3783 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3787 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3789 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3793 /* If any font-related attribute of `menu' is set, set the font. */
3795 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3796 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3797 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3798 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3799 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3801 #if 0 /* Setting the font leads to an infinite loop somewhere
3802 in LessTif during geometry computation. */
3804 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3805 fl
= XmFontListAppendEntry (NULL
, fe
);
3806 XtSetArg (av
[ac
], XmNfontList
, fl
);
3811 xassert (ac
<= sizeof av
/ sizeof *av
);
3815 struct x_resources res
;
3817 XtSetValues (widget
, av
, ac
);
3818 res
.av
= av
, res
.ac
= ac
;
3819 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3821 XmFontListFree (fl
);
3826 #endif /* USE_MOTIF */
3830 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3831 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3834 /* Set widget W's resources from P which points to an x_resources
3838 xl_apply_resources (widget
, p
)
3842 struct x_resources
*res
= (struct x_resources
*) p
;
3843 XtSetValues (widget
, res
->av
, res
->ac
);
3847 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3848 This is the Lucid version. */
3851 xl_set_menu_resources_from_menu_face (f
, widget
)
3860 lface
= lface_from_face_name (f
, Qmenu
, 1);
3861 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3863 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3865 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3869 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3871 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3876 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3877 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3878 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3879 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3880 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3882 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3888 struct x_resources res
;
3890 XtSetValues (widget
, av
, ac
);
3892 /* We must do children here in case we're handling a pop-up menu
3893 in which case WIDGET is a popup shell. XtApplyToWidgets
3894 is a function from lwlib. */
3895 res
.av
= av
, res
.ac
= ac
;
3896 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
3900 #endif /* USE_LUCID */
3903 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
3906 x_set_menu_resources_from_menu_face (f
, widget
)
3911 xl_set_menu_resources_from_menu_face (f
, widget
);
3914 xm_set_menu_resources_from_menu_face (f
, widget
);
3918 #endif /* USE_X_TOOLKIT */
3920 #endif /* HAVE_X_WINDOWS */
3924 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3925 Sinternal_get_lisp_face_attribute
,
3927 "Return face attribute KEYWORD of face SYMBOL.\n\
3928 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
3929 face attribute name, signal an error.\n\
3930 If the optional argument FRAME is given, report on face FACE in that\n\
3931 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
3932 frames). If FRAME is omitted or nil, use the selected frame.")
3933 (symbol
, keyword
, frame
)
3934 Lisp_Object symbol
, keyword
, frame
;
3936 Lisp_Object lface
, value
= Qnil
;
3938 CHECK_SYMBOL (symbol
, 0);
3939 CHECK_SYMBOL (keyword
, 1);
3942 lface
= lface_from_face_name (NULL
, symbol
, 1);
3946 frame
= selected_frame
;
3947 CHECK_LIVE_FRAME (frame
, 2);
3948 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3951 if (EQ (keyword
, QCfamily
))
3952 value
= LFACE_FAMILY (lface
);
3953 else if (EQ (keyword
, QCheight
))
3954 value
= LFACE_HEIGHT (lface
);
3955 else if (EQ (keyword
, QCweight
))
3956 value
= LFACE_WEIGHT (lface
);
3957 else if (EQ (keyword
, QCslant
))
3958 value
= LFACE_SLANT (lface
);
3959 else if (EQ (keyword
, QCunderline
))
3960 value
= LFACE_UNDERLINE (lface
);
3961 else if (EQ (keyword
, QCoverline
))
3962 value
= LFACE_OVERLINE (lface
);
3963 else if (EQ (keyword
, QCstrike_through
))
3964 value
= LFACE_STRIKE_THROUGH (lface
);
3965 else if (EQ (keyword
, QCbox
))
3966 value
= LFACE_BOX (lface
);
3967 else if (EQ (keyword
, QCinverse_video
)
3968 || EQ (keyword
, QCreverse_video
))
3969 value
= LFACE_INVERSE (lface
);
3970 else if (EQ (keyword
, QCforeground
))
3971 value
= LFACE_FOREGROUND (lface
);
3972 else if (EQ (keyword
, QCbackground
))
3973 value
= LFACE_BACKGROUND (lface
);
3974 else if (EQ (keyword
, QCstipple
))
3975 value
= LFACE_STIPPLE (lface
);
3976 else if (EQ (keyword
, QCwidth
))
3977 value
= LFACE_SWIDTH (lface
);
3979 signal_error ("Invalid face attribute name", keyword
);
3985 DEFUN ("internal-lisp-face-attribute-values",
3986 Finternal_lisp_face_attribute_values
,
3987 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3988 "Return a list of valid discrete values for face attribute ATTR.\n\
3989 Value is nil if ATTR doesn't have a discrete set of valid values.")
3993 Lisp_Object result
= Qnil
;
3995 CHECK_SYMBOL (attr
, 0);
3997 if (EQ (attr
, QCweight
)
3998 || EQ (attr
, QCslant
)
3999 || EQ (attr
, QCwidth
))
4001 /* Extract permissible symbols from tables. */
4002 struct table_entry
*table
;
4005 if (EQ (attr
, QCweight
))
4006 table
= weight_table
, dim
= DIM (weight_table
);
4007 else if (EQ (attr
, QCslant
))
4008 table
= slant_table
, dim
= DIM (slant_table
);
4010 table
= swidth_table
, dim
= DIM (swidth_table
);
4012 for (i
= 0; i
< dim
; ++i
)
4014 Lisp_Object symbol
= *table
[i
].symbol
;
4015 Lisp_Object tail
= result
;
4018 && !EQ (XCAR (tail
), symbol
))
4022 result
= Fcons (symbol
, result
);
4025 else if (EQ (attr
, QCunderline
))
4026 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4027 else if (EQ (attr
, QCoverline
))
4028 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4029 else if (EQ (attr
, QCstrike_through
))
4030 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4031 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4032 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4038 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4039 Sinternal_merge_in_global_face
, 2, 2, 0,
4040 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4042 Lisp_Object face
, frame
;
4044 Lisp_Object global_lface
, local_lface
;
4045 CHECK_LIVE_FRAME (frame
, 1);
4046 global_lface
= lface_from_face_name (NULL
, face
, 1);
4047 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4048 if (NILP (local_lface
))
4049 local_lface
= Finternal_make_lisp_face (face
, frame
);
4050 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4051 XVECTOR (local_lface
)->contents
);
4056 /* The following function is implemented for compatibility with 20.2.
4057 The function is used in x-resolve-fonts when it is asked to
4058 return fonts with the same size as the font of a face. This is
4059 done in fontset.el. */
4061 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4062 "Return the font name of face FACE, or nil if it is unspecified.\n\
4063 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4064 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4065 The font default for a face is either nil, or a list\n\
4066 of the form (bold), (italic) or (bold italic).\n\
4067 If FRAME is omitted or nil, use the selected frame.")
4069 Lisp_Object face
, frame
;
4073 Lisp_Object result
= Qnil
;
4074 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4076 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4077 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4078 result
= Fcons (Qbold
, result
);
4080 if (!NILP (LFACE_SLANT (lface
))
4081 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4082 result
= Fcons (Qitalic
, result
);
4088 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4089 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4090 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4091 return build_string (face
->font_name
);
4096 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4097 all attributes are `equal'. Tries to be fast because this function
4098 is called quite often. */
4101 lface_equal_p (v1
, v2
)
4102 Lisp_Object
*v1
, *v2
;
4106 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4108 Lisp_Object a
= v1
[i
];
4109 Lisp_Object b
= v2
[i
];
4111 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4112 and the other is specified. */
4113 equal_p
= XTYPE (a
) == XTYPE (b
);
4122 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4123 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4124 XSTRING (a
)->size
) == 0);
4133 equal_p
= !NILP (Fequal (a
, b
));
4143 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4144 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4145 "True if FACE1 and FACE2 are equal.\n\
4146 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4147 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4148 If FRAME is omitted or nil, use the selected frame.")
4149 (face1
, face2
, frame
)
4150 Lisp_Object face1
, face2
, frame
;
4154 Lisp_Object lface1
, lface2
;
4159 /* Don't use check_x_frame here because this function is called
4160 before X frames exist. At that time, if FRAME is nil,
4161 selected_frame will be used which is the frame dumped with
4162 Emacs. That frame is not an X frame. */
4163 f
= frame_or_selected_frame (frame
, 2);
4165 lface1
= lface_from_face_name (NULL
, face1
, 1);
4166 lface2
= lface_from_face_name (NULL
, face2
, 1);
4167 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4168 XVECTOR (lface2
)->contents
);
4169 return equal_p
? Qt
: Qnil
;
4173 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4174 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4175 "True if FACE has no attribute specified.\n\
4176 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4177 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4178 If FRAME is omitted or nil, use the selected frame.")
4180 Lisp_Object face
, frame
;
4187 frame
= selected_frame
;
4188 CHECK_LIVE_FRAME (frame
, 0);
4192 lface
= lface_from_face_name (NULL
, face
, 1);
4194 lface
= lface_from_face_name (f
, face
, 1);
4196 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4197 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4200 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4204 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4206 "Return an alist of frame-local faces defined on FRAME.\n\
4207 For internal use only.")
4211 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4212 return f
->face_alist
;
4216 /* Return a hash code for Lisp string STRING with case ignored. Used
4217 below in computing a hash value for a Lisp face. */
4219 static INLINE
unsigned
4220 hash_string_case_insensitive (string
)
4225 xassert (STRINGP (string
));
4226 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4227 hash
= (hash
<< 1) ^ tolower (*s
);
4232 /* Return a hash code for face attribute vector V. */
4234 static INLINE
unsigned
4238 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4239 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4240 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4241 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4242 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4243 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4244 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4248 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4249 considering charsets/registries). They do if they specify the same
4250 family, point size, weight, width and slant. Both LFACE1 and
4251 LFACE2 must be fully-specified. */
4254 lface_same_font_attributes_p (lface1
, lface2
)
4255 Lisp_Object
*lface1
, *lface2
;
4257 xassert (lface_fully_specified_p (lface1
)
4258 && lface_fully_specified_p (lface2
));
4259 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4260 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4261 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4262 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4263 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4264 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4265 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4270 /***********************************************************************
4272 ***********************************************************************/
4274 /* Allocate and return a new realized face for Lisp face attribute
4275 vector ATTR, charset CHARSET, and registry REGISTRY. */
4277 static struct face
*
4278 make_realized_face (attr
, charset
, registry
)
4281 Lisp_Object registry
;
4283 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4284 bzero (face
, sizeof *face
);
4285 face
->charset
= charset
;
4286 face
->registry
= registry
;
4287 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4292 /* Free realized face FACE, including its X resources. FACE may
4296 free_realized_face (f
, face
)
4302 #ifdef HAVE_X_WINDOWS
4307 x_free_gc (f
, face
->gc
);
4311 free_face_colors (f
, face
);
4312 x_destroy_bitmap (f
, face
->stipple
);
4314 #endif /* HAVE_X_WINDOWS */
4321 /* Prepare face FACE for subsequent display on frame F. This
4322 allocated GCs if they haven't been allocated yet or have been freed
4323 by clearing the face cache. */
4326 prepare_face_for_display (f
, face
)
4330 #ifdef HAVE_X_WINDOWS
4331 xassert (FRAME_X_P (f
));
4336 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4338 xgcv
.foreground
= face
->foreground
;
4339 xgcv
.background
= face
->background
;
4340 xgcv
.graphics_exposures
= False
;
4342 /* The font of FACE may be null if we couldn't load it. */
4345 xgcv
.font
= face
->font
->fid
;
4352 xgcv
.fill_style
= FillOpaqueStippled
;
4353 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4354 mask
|= GCFillStyle
| GCStipple
;
4357 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4364 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4365 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4366 ISO8859-1 if the ASCII face suffices. */
4369 face_suitable_for_iso8859_1_p (face
)
4372 int len
= strlen (face
->font_name
);
4373 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4377 /* Value is non-zero if FACE is suitable for displaying characters
4378 of CHARSET. CHARSET < 0 means unibyte text. */
4381 face_suitable_for_charset_p (face
, charset
)
4389 if (EQ (face
->registry
, Vface_default_registry
)
4390 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4393 else if (face
->charset
== charset
)
4395 else if (face
->charset
== CHARSET_ASCII
4396 && charset
== charset_latin_iso8859_1
)
4397 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4398 else if (face
->charset
== charset_latin_iso8859_1
4399 && charset
== CHARSET_ASCII
)
4407 /***********************************************************************
4409 ***********************************************************************/
4411 /* Return a new face cache for frame F. */
4413 static struct face_cache
*
4417 struct face_cache
*c
;
4420 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4421 bzero (c
, sizeof *c
);
4422 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4423 c
->buckets
= (struct face
**) xmalloc (size
);
4424 bzero (c
->buckets
, size
);
4426 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4432 /* Clear out all graphics contexts for all realized faces, except for
4433 the basic faces. This should be done from time to time just to avoid
4434 keeping too many graphics contexts that are no longer needed. */
4438 struct face_cache
*c
;
4440 if (c
&& FRAME_X_P (c
->f
))
4442 #ifdef HAVE_X_WINDOWS
4444 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4446 struct face
*face
= c
->faces_by_id
[i
];
4447 if (face
&& face
->gc
)
4449 x_free_gc (c
->f
, face
->gc
);
4453 #endif /* HAVE_X_WINDOWS */
4458 /* Free all realized faces in face cache C, including basic faces. C
4459 may be null. If faces are freed, make sure the frame's current
4460 matrix is marked invalid, so that a display caused by an expose
4461 event doesn't try to use faces we destroyed. */
4464 free_realized_faces (c
)
4465 struct face_cache
*c
;
4470 struct frame
*f
= c
->f
;
4472 for (i
= 0; i
< c
->used
; ++i
)
4474 free_realized_face (f
, c
->faces_by_id
[i
]);
4475 c
->faces_by_id
[i
] = NULL
;
4479 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4480 bzero (c
->buckets
, size
);
4482 /* Must do a thorough redisplay the next time. Mark current
4483 matrices as invalid because they will reference faces freed
4484 above. This function is also called when a frame is
4485 destroyed. In this case, the root window of F is nil. */
4486 if (WINDOWP (f
->root_window
))
4488 clear_current_matrices (f
);
4489 ++windows_or_buffers_changed
;
4495 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4496 This is done after attributes of a named face have been changed,
4497 because we can't tell which realized faces depend on that face. */
4500 free_all_realized_faces (frame
)
4506 FOR_EACH_FRAME (rest
, frame
)
4507 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4510 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4514 /* Free face cache C and faces in it, including their X resources. */
4518 struct face_cache
*c
;
4522 free_realized_faces (c
);
4524 xfree (c
->faces_by_id
);
4530 /* Cache realized face FACE in face cache C. HASH is the hash value
4531 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4532 collision list of the face hash table of C. This is done because
4533 otherwise lookup_face would find FACE for every charset, even if
4534 faces with the same attributes but for specific charsets exist. */
4537 cache_face (c
, face
, hash
)
4538 struct face_cache
*c
;
4542 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4546 if (face
->fontset
>= 0)
4548 struct face
*last
= c
->buckets
[i
];
4559 c
->buckets
[i
] = face
;
4560 face
->prev
= face
->next
= NULL
;
4566 face
->next
= c
->buckets
[i
];
4568 face
->next
->prev
= face
;
4569 c
->buckets
[i
] = face
;
4572 /* Find a free slot in C->faces_by_id and use the index of the free
4573 slot as FACE->id. */
4574 for (i
= 0; i
< c
->used
; ++i
)
4575 if (c
->faces_by_id
[i
] == NULL
)
4579 /* Maybe enlarge C->faces_by_id. */
4580 if (i
== c
->used
&& c
->used
== c
->size
)
4582 int new_size
= 2 * c
->size
;
4583 int sz
= new_size
* sizeof *c
->faces_by_id
;
4584 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4589 /* Check that FACE got a unique id. */
4594 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4595 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4601 #endif /* GLYPH_DEBUG */
4603 c
->faces_by_id
[i
] = face
;
4609 /* Remove face FACE from cache C. */
4612 uncache_face (c
, face
)
4613 struct face_cache
*c
;
4616 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4619 face
->prev
->next
= face
->next
;
4621 c
->buckets
[i
] = face
->next
;
4624 face
->next
->prev
= face
->prev
;
4626 c
->faces_by_id
[face
->id
] = NULL
;
4627 if (face
->id
== c
->used
)
4632 /* Look up a realized face with face attributes ATTR in the face cache
4633 of frame F. The face will be used to display characters of
4634 CHARSET. CHARSET < 0 means the face will be used to display
4635 unibyte text. The value of face-default-registry is used to choose
4636 a font for the face in that case. Value is the ID of the face
4637 found. If no suitable face is found, realize a new one. */
4640 lookup_face (f
, attr
, charset
)
4645 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4650 xassert (c
!= NULL
);
4651 check_lface_attrs (attr
);
4653 /* Look up ATTR in the face cache. */
4654 hash
= lface_hash (attr
);
4655 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4657 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4658 if (face
->hash
== hash
4659 && (!FRAME_WINDOW_P (f
)
4660 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4661 && lface_equal_p (face
->lface
, attr
))
4664 /* If not found, realize a new face. */
4667 face
= realize_face (c
, attr
, charset
);
4668 cache_face (c
, face
, hash
);
4672 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4674 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4675 #endif /* GLYPH_DEBUG */
4681 /* Return the face id of the realized face for named face SYMBOL on
4682 frame F suitable for displaying characters from CHARSET. CHARSET <
4683 0 means unibyte text. */
4686 lookup_named_face (f
, symbol
, charset
)
4691 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4692 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4693 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4695 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4696 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4697 merge_face_vectors (symbol_attrs
, attrs
);
4698 return lookup_face (f
, attrs
, charset
);
4702 /* Return the ID of the realized ASCII face of Lisp face with ID
4703 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4706 ascii_face_of_lisp_face (f
, lface_id
)
4712 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4714 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4715 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4724 /* Return a face for charset ASCII that is like the face with id
4725 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4726 STEPS < 0 means larger. Value is the id of the face. */
4729 smaller_face (f
, face_id
, steps
)
4733 #ifdef HAVE_X_WINDOWS
4735 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4736 int pt
, last_pt
, last_height
;
4739 struct face
*new_face
;
4741 /* If not called for an X frame, just return the original face. */
4742 if (FRAME_TERMCAP_P (f
))
4745 /* Try in increments of 1/2 pt. */
4746 delta
= steps
< 0 ? 5 : -5;
4747 steps
= abs (steps
);
4749 face
= FACE_FROM_ID (f
, face_id
);
4750 bcopy (face
->lface
, attrs
, sizeof attrs
);
4751 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4752 new_face_id
= face_id
;
4753 last_height
= FONT_HEIGHT (face
->font
);
4757 /* Give up if we cannot find a font within 10pt. */
4758 && abs (last_pt
- pt
) < 100)
4760 /* Look up a face for a slightly smaller/larger font. */
4762 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4763 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4764 new_face
= FACE_FROM_ID (f
, new_face_id
);
4766 /* If height changes, count that as one step. */
4767 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4770 last_height
= FONT_HEIGHT (new_face
->font
);
4777 #else /* not HAVE_X_WINDOWS */
4781 #endif /* not HAVE_X_WINDOWS */
4785 /* Return a face for charset ASCII that is like the face with id
4786 FACE_ID on frame F, but has height HEIGHT. */
4789 face_with_height (f
, face_id
, height
)
4794 #ifdef HAVE_X_WINDOWS
4796 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4798 if (FRAME_TERMCAP_P (f
)
4802 face
= FACE_FROM_ID (f
, face_id
);
4803 bcopy (face
->lface
, attrs
, sizeof attrs
);
4804 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4805 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4806 #endif /* HAVE_X_WINDOWS */
4811 /* Return the face id of the realized face for named face SYMBOL on
4812 frame F suitable for displaying characters from CHARSET (CHARSET <
4813 0 means unibyte text), and use attributes of the face FACE_ID for
4814 attributes that aren't completely specified by SYMBOL. This is
4815 like lookup_named_face, except that the default attributes come
4816 from FACE_ID, not from the default face. FACE_ID is assumed to
4817 be already realized. */
4820 lookup_derived_face (f
, symbol
, charset
, face_id
)
4826 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4827 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4828 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4833 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4834 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4835 merge_face_vectors (symbol_attrs
, attrs
);
4836 return lookup_face (f
, attrs
, charset
);
4841 /***********************************************************************
4843 ***********************************************************************/
4845 DEFUN ("internal-set-font-selection-order",
4846 Finternal_set_font_selection_order
,
4847 Sinternal_set_font_selection_order
, 1, 1, 0,
4848 "Set font selection order for face font selection to ORDER.\n\
4849 ORDER must be a list of length 4 containing the symbols `:width',\n\
4850 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4851 first in ORDER are matched first, e.g. if `:height' appears before\n\
4852 `:weight' in ORDER, font selection first tries to find a font with\n\
4853 a suitable height, and then tries to match the font weight.\n\
4862 CHECK_LIST (order
, 0);
4863 bzero (indices
, sizeof indices
);
4867 CONSP (list
) && i
< DIM (indices
);
4868 list
= XCDR (list
), ++i
)
4870 Lisp_Object attr
= XCAR (list
);
4873 if (EQ (attr
, QCwidth
))
4875 else if (EQ (attr
, QCheight
))
4876 xlfd
= XLFD_POINT_SIZE
;
4877 else if (EQ (attr
, QCweight
))
4879 else if (EQ (attr
, QCslant
))
4884 if (indices
[i
] != 0)
4890 || i
!= DIM (indices
)
4895 signal_error ("Invalid font sort order", order
);
4897 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4899 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4900 free_all_realized_faces (Qnil
);
4907 DEFUN ("internal-set-alternative-font-family-alist",
4908 Finternal_set_alternative_font_family_alist
,
4909 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
4910 "Define alternative font families to try in face font selection.\n\
4911 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4912 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
4913 be found. Value is ALIST.")
4917 CHECK_LIST (alist
, 0);
4918 Vface_alternative_font_family_alist
= alist
;
4919 free_all_realized_faces (Qnil
);
4924 #ifdef HAVE_X_WINDOWS
4926 /* Return the X registry and encoding of font name FONT_NAME on frame F.
4927 Value is nil if not successful. */
4930 deduce_unibyte_registry (f
, font_name
)
4934 struct font_name font
;
4935 Lisp_Object registry
= Qnil
;
4937 font
.name
= STRDUPA (font_name
);
4938 if (split_font_name (f
, &font
, 0))
4942 /* Extract registry and encoding. */
4943 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
4944 + strlen (font
.fields
[XLFD_ENCODING
])
4946 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
4947 strcat (buffer
, "-");
4948 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
4949 registry
= build_string (buffer
);
4956 /* Value is non-zero if FONT is the name of a scalable font. The
4957 X11R6 XLFD spec says that point size, pixel size, and average width
4958 are zero for scalable fonts. Intlfonts contain at least one
4959 scalable font ("*-muleindian-1") for which this isn't true, so we
4960 just test average width. */
4963 font_scalable_p (font
)
4964 struct font_name
*font
;
4966 char *s
= font
->fields
[XLFD_AVGWIDTH
];
4967 return *s
== '0' && *(s
+ 1) == '\0';
4971 /* Value is non-zero if FONT1 is a better match for font attributes
4972 VALUES than FONT2. VALUES is an array of face attribute values in
4973 font sort order. COMPARE_PT_P zero means don't compare point
4977 better_font_p (values
, font1
, font2
, compare_pt_p
)
4979 struct font_name
*font1
, *font2
;
4984 for (i
= 0; i
< 4; ++i
)
4986 int xlfd_idx
= font_sort_order
[i
];
4988 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
4990 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
4991 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
4993 if (delta1
> delta2
)
4995 else if (delta1
< delta2
)
4999 /* The difference may be equal because, e.g., the face
5000 specifies `italic' but we have only `regular' and
5001 `oblique'. Prefer `oblique' in this case. */
5002 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5003 && font1
->numeric
[xlfd_idx
] > values
[i
]
5004 && font2
->numeric
[xlfd_idx
] < values
[i
])
5016 /* Value is non-zero if FONT is an exact match for face attributes in
5017 SPECIFIED. SPECIFIED is an array of face attribute values in font
5021 exact_face_match_p (specified
, font
)
5023 struct font_name
*font
;
5027 for (i
= 0; i
< 4; ++i
)
5028 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5035 /* Value is the name of a scaled font, generated from scalable font
5036 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5037 Value is allocated from heap. */
5040 build_scalable_font_name (f
, font
, specified_pt
)
5042 struct font_name
*font
;
5045 char point_size
[20], pixel_size
[20];
5047 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5050 /* If scalable font is for a specific resolution, compute
5051 the point size we must specify from the resolution of
5052 the display and the specified resolution of the font. */
5053 if (font
->numeric
[XLFD_RESY
] != 0)
5055 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5056 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5061 pixel_value
= resy
/ 720.0 * pt
;
5064 /* Set point size of the font. */
5065 sprintf (point_size
, "%d", (int) pt
);
5066 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5067 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5069 /* Set pixel size. */
5070 sprintf (pixel_size
, "%d", pixel_value
);
5071 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5072 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5074 /* If font doesn't specify its resolution, use the
5075 resolution of the display. */
5076 if (font
->numeric
[XLFD_RESY
] == 0)
5079 sprintf (buffer
, "%d", (int) resy
);
5080 font
->fields
[XLFD_RESY
] = buffer
;
5081 font
->numeric
[XLFD_RESY
] = resy
;
5084 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5087 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5088 sprintf (buffer
, "%d", resx
);
5089 font
->fields
[XLFD_RESX
] = buffer
;
5090 font
->numeric
[XLFD_RESX
] = resx
;
5093 return build_font_name (font
);
5097 /* Value is non-zero if we are allowed to use scalable font FONT. We
5098 can't run a Lisp function here since this function may be called
5099 with input blocked. */
5102 may_use_scalable_font_p (font
, name
)
5103 struct font_name
*font
;
5106 if (EQ (Vscalable_fonts_allowed
, Qt
))
5108 else if (CONSP (Vscalable_fonts_allowed
))
5110 Lisp_Object tail
, regexp
;
5112 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5114 regexp
= XCAR (tail
);
5115 if (STRINGP (regexp
)
5116 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5124 #endif /* SCALABLE_FONTS != 0 */
5127 /* Return the name of the best matching font for face attributes
5128 ATTRS in the array of font_name structures FONTS which contains
5129 NFONTS elements. Value is a font name which is allocated from
5130 the heap. FONTS is freed by this function. */
5133 best_matching_font (f
, attrs
, fonts
, nfonts
)
5136 struct font_name
*fonts
;
5140 struct font_name
*best
;
5148 /* Make specified font attributes available in `specified',
5149 indexed by sort order. */
5150 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5152 int xlfd_idx
= font_sort_order
[i
];
5154 if (xlfd_idx
== XLFD_SWIDTH
)
5155 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5156 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5157 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5158 else if (xlfd_idx
== XLFD_WEIGHT
)
5159 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5160 else if (xlfd_idx
== XLFD_SLANT
)
5161 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5171 /* Start with the first non-scalable font in the list. */
5172 for (i
= 0; i
< nfonts
; ++i
)
5173 if (!font_scalable_p (fonts
+ i
))
5176 /* Find the best match among the non-scalable fonts. */
5181 for (i
= 1; i
< nfonts
; ++i
)
5182 if (!font_scalable_p (fonts
+ i
)
5183 && better_font_p (specified
, fonts
+ i
, best
, 1))
5187 exact_p
= exact_face_match_p (specified
, best
);
5196 /* Unless we found an exact match among non-scalable fonts, see if
5197 we can find a better match among scalable fonts. */
5200 /* A scalable font is better if
5202 1. its weight, slant, swidth attributes are better, or.
5204 2. the best non-scalable font doesn't have the required
5205 point size, and the scalable fonts weight, slant, swidth
5208 int non_scalable_has_exact_height_p
;
5210 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5211 non_scalable_has_exact_height_p
= 1;
5213 non_scalable_has_exact_height_p
= 0;
5215 for (i
= 0; i
< nfonts
; ++i
)
5216 if (font_scalable_p (fonts
+ i
))
5219 || better_font_p (specified
, fonts
+ i
, best
, 0)
5220 || (!non_scalable_has_exact_height_p
5221 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5226 if (font_scalable_p (best
))
5227 font_name
= build_scalable_font_name (f
, best
, pt
);
5229 font_name
= build_font_name (best
);
5231 #else /* !SCALABLE_FONTS */
5233 /* Find the best non-scalable font. */
5236 for (i
= 1; i
< nfonts
; ++i
)
5238 xassert (!font_scalable_p (fonts
+ i
));
5239 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5243 font_name
= build_font_name (best
);
5245 #endif /* !SCALABLE_FONTS */
5247 /* Free font_name structures. */
5248 free_font_names (fonts
, nfonts
);
5254 /* Try to get a list of fonts on frame F with font family FAMILY and
5255 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5256 of font_name structures for the fonts matched. Value is the number
5260 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5263 char *pattern
, *family
, *registry
;
5264 struct font_name
**fonts
;
5269 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5271 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5277 /* Try alternative font families from
5278 Vface_alternative_font_family_alist. */
5279 alter
= Fassoc (build_string (family
),
5280 Vface_alternative_font_family_alist
);
5282 for (alter
= XCDR (alter
);
5283 CONSP (alter
) && nfonts
== 0;
5284 alter
= XCDR (alter
))
5286 if (STRINGP (XCAR (alter
)))
5288 family
= LSTRDUPA (XCAR (alter
));
5289 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5293 /* Try font family of the default face or "fixed". */
5296 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5298 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5301 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5304 /* Try any family with the given registry. */
5306 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5313 /* Return the registry and encoding pattern that fonts for CHARSET
5314 should match. Value is allocated from the heap. */
5317 x_charset_registry (charset
)
5320 Lisp_Object prop
, charset_plist
;
5323 /* Get registry and encoding from the charset's plist. */
5324 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5325 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5329 if (index (XSTRING (prop
)->data
, '-'))
5330 registry
= xstrdup (XSTRING (prop
)->data
);
5333 /* If registry doesn't contain a `-', make it a pattern. */
5334 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5335 strcpy (registry
, XSTRING (prop
)->data
);
5336 strcat (registry
, "*-*");
5339 else if (STRINGP (Vface_default_registry
))
5340 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5342 registry
= xstrdup ("iso8859-1");
5348 /* Return the fontset id of the fontset name or alias name given by
5349 the family attribute of ATTRS on frame F. Value is -1 if the
5350 family attribute of ATTRS doesn't name a fontset. */
5353 face_fontset (f
, attrs
)
5357 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5360 name
= Fquery_fontset (name
, Qnil
);
5364 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5370 /* Get the font to use for the face realizing the fully-specified Lisp
5371 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5372 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5373 in this case. Value is the font name which is allocated from the
5374 heap (which means that it must be freed eventually). */
5377 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5381 Lisp_Object unibyte_registry
;
5383 struct font_name
*fonts
;
5387 /* ATTRS must be fully-specified. */
5388 xassert (lface_fully_specified_p (attrs
));
5390 if (STRINGP (unibyte_registry
))
5391 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5393 registry
= x_charset_registry (charset
);
5395 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5397 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5401 /* Choose a font to use on frame F to display CHARSET using FONTSET
5402 with Lisp face attributes specified by ATTRS. CHARSET may be any
5403 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
5404 unibyte text. If the fontset doesn't contain a font pattern for
5405 charset, use the pattern for CHARSET_ASCII. Value is the font name
5406 which is allocated from the heap and must be freed by the caller. */
5409 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5412 int fontset
, charset
;
5415 char *font_name
= NULL
;
5416 struct fontset_info
*fontset_info
;
5417 struct font_name
*fonts
;
5420 xassert (charset
!= CHARSET_COMPOSITION
);
5421 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5423 /* For unibyte text, use the ASCII font of the fontset. Using the
5424 ASCII font seems to be the most reasonable thing we can do in
5427 charset
= CHARSET_ASCII
;
5429 /* Get the font name pattern to use for CHARSET from the fontset. */
5430 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5431 pattern
= fontset_info
->fontname
[charset
];
5433 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5436 /* Get a list of fonts matching that pattern and choose the
5437 best match for the specified face attributes from it. */
5438 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5439 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5443 #endif /* HAVE_X_WINDOWS */
5447 /***********************************************************************
5449 ***********************************************************************/
5451 /* Realize basic faces on frame F. Value is zero if frame parameters
5452 of F don't contain enough information needed to realize the default
5456 realize_basic_faces (f
)
5461 if (realize_default_face (f
))
5463 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5464 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5465 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5466 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5467 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5468 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5469 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5470 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5471 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5479 /* Realize the default face on frame F. If the face is not fully
5480 specified, make it fully-specified. Attributes of the default face
5481 that are not explicitly specified are taken from frame parameters. */
5484 realize_default_face (f
)
5487 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5489 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5490 Lisp_Object unibyte_registry
;
5491 Lisp_Object frame_font
;
5495 /* If the `default' face is not yet known, create it. */
5496 lface
= lface_from_face_name (f
, Qdefault
, 0);
5500 XSETFRAME (frame
, f
);
5501 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5504 #ifdef HAVE_X_WINDOWS
5507 /* Set frame_font to the value of the `font' frame parameter. */
5508 frame_font
= Fassq (Qfont
, f
->param_alist
);
5509 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5510 frame_font
= XCDR (frame_font
);
5512 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5515 /* If frame_font is a fontset name, don't use that for
5516 determining font-related attributes of the default face
5517 because it is just an artificial name. Use the ASCII font of
5518 the fontset, instead. */
5519 struct font_info
*font_info
;
5520 struct font_name font
;
5523 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5527 /* Set weight etc. from the ASCII font. */
5528 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0))
5531 /* Remember registry and encoding of the frame font. */
5532 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5533 if (STRINGP (unibyte_registry
))
5534 Vface_default_registry
= unibyte_registry
;
5536 Vface_default_registry
= build_string ("iso8859-1");
5538 /* But set the family to the fontset alias name. Implementation
5539 note: When a font is passed to Emacs via `-fn FONT', a
5540 fontset is created in `x-win.el' whose name ends in
5541 `fontset-startup'. This fontset has an alias name that is
5542 equal to frame_font. */
5543 xassert (STRINGP (frame_font
));
5544 font
.name
= LSTRDUPA (frame_font
);
5546 if (!split_font_name (f
, &font
, 1)
5547 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5548 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5549 LFACE_FAMILY (lface
) = frame_font
;
5553 /* Frame parameters contain a real font. Fill default face
5554 attributes from that font. */
5555 if (!set_lface_from_font_name (f
, lface
,
5556 XSTRING (frame_font
)->data
, 0))
5559 /* Remember registry and encoding of the frame font. */
5561 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5562 if (STRINGP (unibyte_registry
))
5563 Vface_default_registry
= unibyte_registry
;
5565 Vface_default_registry
= build_string ("iso8859-1");
5568 #endif /* HAVE_X_WINDOWS */
5570 if (!FRAME_WINDOW_P (f
))
5572 LFACE_FAMILY (lface
) = build_string ("default");
5573 LFACE_SWIDTH (lface
) = Qnormal
;
5574 LFACE_HEIGHT (lface
) = make_number (1);
5575 LFACE_WEIGHT (lface
) = Qnormal
;
5576 LFACE_SLANT (lface
) = Qnormal
;
5579 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5580 LFACE_UNDERLINE (lface
) = Qnil
;
5582 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5583 LFACE_OVERLINE (lface
) = Qnil
;
5585 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5586 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5588 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5589 LFACE_BOX (lface
) = Qnil
;
5591 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5592 LFACE_INVERSE (lface
) = Qnil
;
5594 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5596 /* This function is called so early that colors are not yet
5597 set in the frame parameter list. */
5598 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5600 if (CONSP (color
) && STRINGP (XCDR (color
)))
5601 LFACE_FOREGROUND (lface
) = XCDR (color
);
5602 else if (FRAME_X_P (f
))
5604 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5605 /* Frame parameters for terminal frames usually don't contain
5606 a color. Use an empty string to indicate that the face
5607 should use the (unknown) default color of the terminal. */
5608 LFACE_FOREGROUND (lface
) = build_string ("");
5613 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5615 /* This function is called so early that colors are not yet
5616 set in the frame parameter list. */
5617 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5618 if (CONSP (color
) && STRINGP (XCDR (color
)))
5619 LFACE_BACKGROUND (lface
) = XCDR (color
);
5620 else if (FRAME_X_P (f
))
5622 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5623 /* Frame parameters for terminal frames usually don't contain
5624 a color. Use an empty string to indicate that the face
5625 should use the (unknown) default color of the terminal. */
5626 LFACE_BACKGROUND (lface
) = build_string ("");
5631 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5632 LFACE_STIPPLE (lface
) = Qnil
;
5634 /* Realize the face; it must be fully-specified now. */
5635 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5636 check_lface (lface
);
5637 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5638 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5640 /* Remove the former default face. */
5641 if (c
->used
> DEFAULT_FACE_ID
)
5643 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5644 uncache_face (c
, default_face
);
5645 free_realized_face (f
, default_face
);
5648 /* Insert the new default face. */
5649 cache_face (c
, face
, lface_hash (attrs
));
5650 xassert (face
->id
== DEFAULT_FACE_ID
);
5655 /* Realize basic faces other than the default face in face cache C.
5656 SYMBOL is the face name, ID is the face id the realized face must
5657 have. The default face must have been realized already. */
5660 realize_named_face (f
, symbol
, id
)
5665 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5666 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5667 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5668 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5669 struct face
*new_face
;
5671 /* The default face must exist and be fully specified. */
5672 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5673 check_lface_attrs (attrs
);
5674 xassert (lface_fully_specified_p (attrs
));
5676 /* If SYMBOL isn't know as a face, create it. */
5680 XSETFRAME (frame
, f
);
5681 lface
= Finternal_make_lisp_face (symbol
, frame
);
5684 /* Merge SYMBOL's face with the default face. */
5685 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5686 merge_face_vectors (symbol_attrs
, attrs
);
5688 /* Realize the face. */
5689 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5691 /* Remove the former face. */
5694 struct face
*old_face
= c
->faces_by_id
[id
];
5695 uncache_face (c
, old_face
);
5696 free_realized_face (f
, old_face
);
5699 /* Insert the new face. */
5700 cache_face (c
, new_face
, lface_hash (attrs
));
5701 xassert (new_face
->id
== id
);
5705 /* Realize the fully-specified face with attributes ATTRS in face
5706 cache C for character set CHARSET or for unibyte text if CHARSET <
5707 0. Value is a pointer to the newly created realized face. */
5709 static struct face
*
5710 realize_face (c
, attrs
, charset
)
5711 struct face_cache
*c
;
5717 /* LFACE must be fully specified. */
5718 xassert (c
!= NULL
);
5719 check_lface_attrs (attrs
);
5721 if (FRAME_X_P (c
->f
))
5722 face
= realize_x_face (c
, attrs
, charset
);
5723 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5724 face
= realize_tty_face (c
, attrs
, charset
);
5732 /* Realize the fully-specified face with attributes ATTRS in face
5733 cache C for character set CHARSET or for unibyte text if CHARSET <
5734 0. Do it for X frame C->f. Value is a pointer to the newly
5735 created realized face. */
5737 static struct face
*
5738 realize_x_face (c
, attrs
, charset
)
5739 struct face_cache
*c
;
5743 #ifdef HAVE_X_WINDOWS
5744 struct face
*face
, *default_face
;
5745 struct frame
*f
= c
->f
;
5746 Lisp_Object stipple
, overline
, strike_through
, box
;
5747 Lisp_Object unibyte_registry
;
5748 struct gcpro gcpro1
;
5750 xassert (FRAME_X_P (f
));
5752 /* If realizing a face for use in unibyte text, get the X registry
5753 and encoding to use from Vface_default_registry. */
5755 unibyte_registry
= (STRINGP (Vface_default_registry
)
5756 ? Vface_default_registry
5757 : build_string ("iso8859-1"));
5759 unibyte_registry
= Qnil
;
5760 GCPRO1 (unibyte_registry
);
5762 /* Allocate a new realized face. */
5763 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5765 /* Determine the font to use. Most of the time, the font will be
5766 the same as the font of the default face, so try that first. */
5767 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5769 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5770 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5772 face
->font
= default_face
->font
;
5773 face
->fontset
= default_face
->fontset
;
5774 face
->font_info_id
= default_face
->font_info_id
;
5775 face
->font_name
= default_face
->font_name
;
5776 face
->registry
= default_face
->registry
;
5778 else if (charset
>= 0)
5780 /* For all charsets except CHARSET_COMPOSITION, we use our own
5781 font selection functions to choose a best matching font for
5782 the specified face attributes. If the face specifies a
5783 fontset alias name, the fontset determines the font name
5784 pattern, otherwise we construct a font pattern from face
5785 attributes and charset.
5787 If charset is CHARSET_COMPOSITION, we always construct a face
5788 with a fontset, even if the face doesn't specify a fontset alias
5789 (we use fontset-standard in that case). When the composite
5790 character is displayed in xterm.c, a suitable concrete font is
5791 loaded in x_get_char_font_and_encoding. */
5793 char *font_name
= NULL
;
5794 int fontset
= face_fontset (f
, attrs
);
5796 if (charset
== CHARSET_COMPOSITION
)
5797 fontset
= max (0, fontset
);
5798 else if (fontset
< 0)
5799 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5802 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5806 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5811 /* Unibyte case, and font is not equal to that of the default
5812 face. UNIBYTE_REGISTRY is the X registry and encoding the
5813 font should have. What is a reasonable thing to do if the
5814 user specified a fontset alias name for the face in this
5815 case? We choose a font by taking the ASCII font of the
5816 fontset, but using UNIBYTE_REGISTRY for its registry and
5819 char *font_name
= NULL
;
5820 int fontset
= face_fontset (f
, attrs
);
5823 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5825 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5827 load_face_font_or_fontset (f
, face
, font_name
, -1);
5831 /* Load colors, and set remaining attributes. */
5833 load_face_colors (f
, face
, attrs
);
5836 box
= attrs
[LFACE_BOX_INDEX
];
5839 /* A simple box of line width 1 drawn in color given by
5841 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5843 face
->box
= FACE_SIMPLE_BOX
;
5844 face
->box_line_width
= 1;
5846 else if (INTEGERP (box
))
5848 /* Simple box of specified line width in foreground color of the
5850 xassert (XINT (box
) > 0);
5851 face
->box
= FACE_SIMPLE_BOX
;
5852 face
->box_line_width
= XFASTINT (box
);
5853 face
->box_color
= face
->foreground
;
5854 face
->box_color_defaulted_p
= 1;
5856 else if (CONSP (box
))
5858 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5859 being one of `raised' or `sunken'. */
5860 face
->box
= FACE_SIMPLE_BOX
;
5861 face
->box_color
= face
->foreground
;
5862 face
->box_color_defaulted_p
= 1;
5863 face
->box_line_width
= 1;
5867 Lisp_Object keyword
, value
;
5869 keyword
= XCAR (box
);
5877 if (EQ (keyword
, QCline_width
))
5879 if (INTEGERP (value
) && XINT (value
) > 0)
5880 face
->box_line_width
= XFASTINT (value
);
5882 else if (EQ (keyword
, QCcolor
))
5884 if (STRINGP (value
))
5886 face
->box_color
= load_color (f
, face
, value
,
5888 face
->use_box_color_for_shadows_p
= 1;
5891 else if (EQ (keyword
, QCstyle
))
5893 if (EQ (value
, Qreleased_button
))
5894 face
->box
= FACE_RAISED_BOX
;
5895 else if (EQ (value
, Qpressed_button
))
5896 face
->box
= FACE_SUNKEN_BOX
;
5901 /* Text underline, overline, strike-through. */
5903 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5905 /* Use default color (same as foreground color). */
5906 face
->underline_p
= 1;
5907 face
->underline_defaulted_p
= 1;
5908 face
->underline_color
= 0;
5910 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5912 /* Use specified color. */
5913 face
->underline_p
= 1;
5914 face
->underline_defaulted_p
= 0;
5915 face
->underline_color
5916 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5917 LFACE_UNDERLINE_INDEX
);
5919 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5921 face
->underline_p
= 0;
5922 face
->underline_defaulted_p
= 0;
5923 face
->underline_color
= 0;
5926 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5927 if (STRINGP (overline
))
5929 face
->overline_color
5930 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5931 LFACE_OVERLINE_INDEX
);
5932 face
->overline_p
= 1;
5934 else if (EQ (overline
, Qt
))
5936 face
->overline_color
= face
->foreground
;
5937 face
->overline_color_defaulted_p
= 1;
5938 face
->overline_p
= 1;
5941 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5942 if (STRINGP (strike_through
))
5944 face
->strike_through_color
5945 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5946 LFACE_STRIKE_THROUGH_INDEX
);
5947 face
->strike_through_p
= 1;
5949 else if (EQ (strike_through
, Qt
))
5951 face
->strike_through_color
= face
->foreground
;
5952 face
->strike_through_color_defaulted_p
= 1;
5953 face
->strike_through_p
= 1;
5956 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5957 if (!NILP (stipple
))
5958 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5961 xassert (face
->fontset
< 0 || face
->charset
== CHARSET_COMPOSITION
);
5962 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
5964 #endif /* HAVE_X_WINDOWS */
5968 /* Realize the fully-specified face with attributes ATTRS in face
5969 cache C for character set CHARSET or for unibyte text if CHARSET <
5970 0. Do it for TTY frame C->f. Value is a pointer to the newly
5971 created realized face. */
5973 static struct face
*
5974 realize_tty_face (c
, attrs
, charset
)
5975 struct face_cache
*c
;
5983 /* Frame must be a termcap frame. */
5984 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
5986 /* Allocate a new realized face. */
5987 face
= make_realized_face (attrs
, charset
, Qnil
);
5988 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
5990 /* Map face attributes to TTY appearances. We map slant to
5991 dimmed text because we want italic text to appear differently
5992 and because dimmed text is probably used infrequently. */
5993 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5994 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5996 if (weight
> XLFD_WEIGHT_MEDIUM
)
5997 face
->tty_bold_p
= 1;
5998 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
5999 face
->tty_dim_p
= 1;
6000 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6001 face
->tty_underline_p
= 1;
6002 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6003 face
->tty_reverse_p
= 1;
6005 /* Map color names to color indices. */
6006 face
->foreground
= face
->background
= FACE_TTY_DEFAULT_COLOR
;
6008 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6009 if (XSTRING (color
)->size
6010 && (color
= Fassoc (color
, Vface_tty_color_alist
),
6012 face
->foreground
= XINT (XCDR (color
));
6015 if (FRAME_MSDOS_P (c
->f
) && face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6017 face
->foreground
= load_color (c
->f
, face
,
6018 attrs
[LFACE_FOREGROUND_INDEX
],
6019 LFACE_FOREGROUND_INDEX
);
6020 /* If the foreground of the default face is the default color,
6021 use the foreground color defined by the frame. */
6022 if (face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6024 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6025 attrs
[LFACE_FOREGROUND_INDEX
] =
6026 build_string (msdos_stdcolor_name (face
->foreground
));
6031 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6032 if (XSTRING (color
)->size
6033 && (color
= Fassoc (color
, Vface_tty_color_alist
),
6035 face
->background
= XINT (XCDR (color
));
6038 if (FRAME_MSDOS_P (c
->f
) && face
->background
== FACE_TTY_DEFAULT_COLOR
)
6040 face
->background
= load_color (c
->f
, face
,
6041 attrs
[LFACE_BACKGROUND_INDEX
],
6042 LFACE_BACKGROUND_INDEX
);
6043 /* If the background of the default face is the default color,
6044 use the background color defined by the frame. */
6045 if (face
->background
== FACE_TTY_DEFAULT_COLOR
)
6047 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6048 attrs
[LFACE_BACKGROUND_INDEX
] =
6049 build_string (msdos_stdcolor_name (face
->background
));
6053 /* Swap colors if face is inverse-video. */
6054 if (face
->tty_reverse_p
)
6056 unsigned long tem
= face
->foreground
;
6058 face
->foreground
= face
->background
;
6059 face
->background
= tem
;
6067 DEFUN ("face-register-tty-color", Fface_register_tty_color
,
6068 Sface_register_tty_color
, 2, 2, 0,
6069 "Say that COLOR is color number NUMBER on the terminal.\n\
6070 COLOR is a string, the color name. Value is COLOR.")
6072 Lisp_Object color
, number
;
6076 CHECK_STRING (color
, 0);
6077 CHECK_NUMBER (number
, 1);
6078 entry
= Fassoc (color
, Vface_tty_color_alist
);
6080 Vface_tty_color_alist
= Fcons (Fcons (color
, number
),
6081 Vface_tty_color_alist
);
6083 Fsetcdr (entry
, number
);
6088 DEFUN ("face-clear-tty-colors", Fface_clear_tty_colors
,
6089 Sface_clear_tty_colors
, 0, 0, 0,
6090 "Unregister all registered tty colors.")
6093 return Vface_tty_color_alist
= Qnil
;
6097 DEFUN ("tty-defined-colors", Ftty_defined_colors
,
6098 Stty_defined_colors
, 0, 0, 0,
6099 "Return a list of registered tty colors.")
6102 Lisp_Object list
, colors
;
6105 for (list
= Vface_tty_color_alist
; CONSP (list
); list
= XCDR (list
))
6106 colors
= Fcons (XCAR (XCAR (list
)), colors
);
6113 /***********************************************************************
6115 ***********************************************************************/
6117 /* Return the ID of the face to use to display character CH with face
6118 property PROP on frame F in current_buffer. */
6121 compute_char_face (f
, ch
, prop
)
6127 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6129 : CHAR_CHARSET (ch
));
6132 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6135 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6136 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6137 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6138 merge_face_vector_with_property (f
, attrs
, prop
);
6139 face_id
= lookup_face (f
, attrs
, charset
);
6146 /* Return the face ID associated with buffer position POS for
6147 displaying ASCII characters. Return in *ENDPTR the position at
6148 which a different face is needed, as far as text properties and
6149 overlays are concerned. W is a window displaying current_buffer.
6151 REGION_BEG, REGION_END delimit the region, so it can be
6154 LIMIT is a position not to scan beyond. That is to limit the time
6155 this function can take.
6157 If MOUSE is non-zero, use the character's mouse-face, not its face.
6159 The face returned is suitable for displaying CHARSET_ASCII if
6160 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6161 the face is suitable for displaying unibyte text. */
6164 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6165 endptr
, limit
, mouse
)
6168 int region_beg
, region_end
;
6173 struct frame
*f
= XFRAME (w
->frame
);
6174 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6175 Lisp_Object prop
, position
;
6177 Lisp_Object
*overlay_vec
;
6180 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6181 Lisp_Object limit1
, end
;
6182 struct face
*default_face
;
6183 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6185 /* W must display the current buffer. We could write this function
6186 to use the frame and buffer of W, but right now it doesn't. */
6187 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6189 XSETFRAME (frame
, f
);
6190 XSETFASTINT (position
, pos
);
6193 if (pos
< region_beg
&& region_beg
< endpos
)
6194 endpos
= region_beg
;
6196 /* Get the `face' or `mouse_face' text property at POS, and
6197 determine the next position at which the property changes. */
6198 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6199 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6200 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6202 endpos
= XINT (end
);
6204 /* Look at properties from overlays. */
6209 /* First try with room for 40 overlays. */
6211 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6212 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6213 &next_overlay
, NULL
);
6215 /* If there are more than 40, make enough space for all, and try
6217 if (noverlays
> len
)
6220 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6221 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6222 &next_overlay
, NULL
);
6225 if (next_overlay
< endpos
)
6226 endpos
= next_overlay
;
6231 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6233 /* Optimize common cases where we can use the default face. */
6236 && !(pos
>= region_beg
&& pos
< region_end
)
6238 || !FRAME_WINDOW_P (f
)
6239 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6240 return DEFAULT_FACE_ID
;
6242 /* Begin with attributes from the default face. */
6243 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6245 /* Merge in attributes specified via text properties. */
6247 merge_face_vector_with_property (f
, attrs
, prop
);
6249 /* Now merge the overlay data. */
6250 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6251 for (i
= 0; i
< noverlays
; i
++)
6256 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6258 merge_face_vector_with_property (f
, attrs
, prop
);
6260 oend
= OVERLAY_END (overlay_vec
[i
]);
6261 oendpos
= OVERLAY_POSITION (oend
);
6262 if (oendpos
< endpos
)
6266 /* If in the region, merge in the region face. */
6267 if (pos
>= region_beg
&& pos
< region_end
)
6269 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6270 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6272 if (region_end
< endpos
)
6273 endpos
= region_end
;
6278 /* Look up a realized face with the given face attributes,
6279 or realize a new one. Charset is ignored for tty frames. */
6280 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6284 /* Compute the face at character position POS in Lisp string STRING on
6285 window W, for charset CHARSET_ASCII.
6287 If STRING is an overlay string, it comes from position BUFPOS in
6288 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6289 not an overlay string. W must display the current buffer.
6290 REGION_BEG and REGION_END give the start and end positions of the
6291 region; both are -1 if no region is visible. BASE_FACE_ID is the
6292 id of the basic face to merge with. It is usually equal to
6293 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6294 for strings displayed in the mode or top line.
6296 Set *ENDPTR to the next position where to check for faces in
6297 STRING; -1 if the face is constant from POS to the end of the
6300 Value is the id of the face to use. The face returned is suitable
6301 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6302 the face is suitable for displaying unibyte text. */
6305 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6306 region_end
, endptr
, base_face_id
)
6310 int region_beg
, region_end
;
6312 enum face_id base_face_id
;
6314 Lisp_Object prop
, position
, end
, limit
;
6315 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6316 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6317 struct face
*base_face
;
6318 int multibyte_p
= STRING_MULTIBYTE (string
);
6320 /* Get the value of the face property at the current position within
6321 STRING. Value is nil if there is no face property. */
6322 XSETFASTINT (position
, pos
);
6323 prop
= Fget_text_property (position
, Qface
, string
);
6325 /* Get the next position at which to check for faces. Value of end
6326 is nil if face is constant all the way to the end of the string.
6327 Otherwise it is a string position where to check faces next.
6328 Limit is the maximum position up to which to check for property
6329 changes in Fnext_single_property_change. Strings are usually
6330 short, so set the limit to the end of the string. */
6331 XSETFASTINT (limit
, XSTRING (string
)->size
);
6332 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6334 *endptr
= XFASTINT (end
);
6338 base_face
= FACE_FROM_ID (f
, base_face_id
);
6339 xassert (base_face
);
6341 /* Optimize the default case that there is no face property and we
6342 are not in the region. */
6344 && (base_face_id
!= DEFAULT_FACE_ID
6345 /* BUFPOS <= 0 means STRING is not an overlay string, so
6346 that the region doesn't have to be taken into account. */
6348 || bufpos
< region_beg
6349 || bufpos
>= region_end
)
6351 /* We can't realize faces for different charsets differently
6352 if we don't have fonts, so we can stop here if not working
6353 on a window-system frame. */
6354 || !FRAME_WINDOW_P (f
)
6355 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6356 return base_face
->id
;
6358 /* Begin with attributes from the base face. */
6359 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6361 /* Merge in attributes specified via text properties. */
6363 merge_face_vector_with_property (f
, attrs
, prop
);
6365 /* If in the region, merge in the region face. */
6367 && bufpos
>= region_beg
6368 && bufpos
< region_end
)
6370 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6371 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6374 /* Look up a realized face with the given face attributes,
6375 or realize a new one. */
6376 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6381 /***********************************************************************
6383 ***********************************************************************/
6387 /* Print the contents of the realized face FACE to stderr. */
6390 dump_realized_face (face
)
6393 fprintf (stderr
, "ID: %d\n", face
->id
);
6394 #ifdef HAVE_X_WINDOWS
6395 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6397 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6399 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6400 fprintf (stderr
, "background: 0x%lx (%s)\n",
6402 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6403 fprintf (stderr
, "font_name: %s (%s)\n",
6405 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6406 #ifdef HAVE_X_WINDOWS
6407 fprintf (stderr
, "font = %p\n", face
->font
);
6409 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6410 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6411 fprintf (stderr
, "underline: %d (%s)\n",
6413 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6414 fprintf (stderr
, "hash: %d\n", face
->hash
);
6415 fprintf (stderr
, "charset: %d\n", face
->charset
);
6419 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6427 fprintf (stderr
, "font selection order: ");
6428 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6429 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6430 fprintf (stderr
, "\n");
6432 fprintf (stderr
, "alternative fonts: ");
6433 debug_print (Vface_alternative_font_family_alist
);
6434 fprintf (stderr
, "\n");
6436 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6437 Fdump_face (make_number (i
));
6442 CHECK_NUMBER (n
, 0);
6443 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6445 error ("Not a valid face");
6446 dump_realized_face (face
);
6453 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6457 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6458 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6459 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6463 #endif /* GLYPH_DEBUG != 0 */
6467 /***********************************************************************
6469 ***********************************************************************/
6474 Qface
= intern ("face");
6476 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6477 staticpro (&Qbitmap_spec_p
);
6478 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6479 staticpro (&Qframe_update_face_colors
);
6481 /* Lisp face attribute keywords. */
6482 QCfamily
= intern (":family");
6483 staticpro (&QCfamily
);
6484 QCheight
= intern (":height");
6485 staticpro (&QCheight
);
6486 QCweight
= intern (":weight");
6487 staticpro (&QCweight
);
6488 QCslant
= intern (":slant");
6489 staticpro (&QCslant
);
6490 QCunderline
= intern (":underline");
6491 staticpro (&QCunderline
);
6492 QCinverse_video
= intern (":inverse-video");
6493 staticpro (&QCinverse_video
);
6494 QCreverse_video
= intern (":reverse-video");
6495 staticpro (&QCreverse_video
);
6496 QCforeground
= intern (":foreground");
6497 staticpro (&QCforeground
);
6498 QCbackground
= intern (":background");
6499 staticpro (&QCbackground
);
6500 QCstipple
= intern (":stipple");;
6501 staticpro (&QCstipple
);
6502 QCwidth
= intern (":width");
6503 staticpro (&QCwidth
);
6504 QCfont
= intern (":font");
6505 staticpro (&QCfont
);
6506 QCbold
= intern (":bold");
6507 staticpro (&QCbold
);
6508 QCitalic
= intern (":italic");
6509 staticpro (&QCitalic
);
6510 QCoverline
= intern (":overline");
6511 staticpro (&QCoverline
);
6512 QCstrike_through
= intern (":strike-through");
6513 staticpro (&QCstrike_through
);
6514 QCbox
= intern (":box");
6517 /* Symbols used for Lisp face attribute values. */
6518 QCcolor
= intern (":color");
6519 staticpro (&QCcolor
);
6520 QCline_width
= intern (":line-width");
6521 staticpro (&QCline_width
);
6522 QCstyle
= intern (":style");
6523 staticpro (&QCstyle
);
6524 Qreleased_button
= intern ("released-button");
6525 staticpro (&Qreleased_button
);
6526 Qpressed_button
= intern ("pressed-button");
6527 staticpro (&Qpressed_button
);
6528 Qnormal
= intern ("normal");
6529 staticpro (&Qnormal
);
6530 Qultra_light
= intern ("ultra-light");
6531 staticpro (&Qultra_light
);
6532 Qextra_light
= intern ("extra-light");
6533 staticpro (&Qextra_light
);
6534 Qlight
= intern ("light");
6535 staticpro (&Qlight
);
6536 Qsemi_light
= intern ("semi-light");
6537 staticpro (&Qsemi_light
);
6538 Qsemi_bold
= intern ("semi-bold");
6539 staticpro (&Qsemi_bold
);
6540 Qbold
= intern ("bold");
6542 Qextra_bold
= intern ("extra-bold");
6543 staticpro (&Qextra_bold
);
6544 Qultra_bold
= intern ("ultra-bold");
6545 staticpro (&Qultra_bold
);
6546 Qoblique
= intern ("oblique");
6547 staticpro (&Qoblique
);
6548 Qitalic
= intern ("italic");
6549 staticpro (&Qitalic
);
6550 Qreverse_oblique
= intern ("reverse-oblique");
6551 staticpro (&Qreverse_oblique
);
6552 Qreverse_italic
= intern ("reverse-italic");
6553 staticpro (&Qreverse_italic
);
6554 Qultra_condensed
= intern ("ultra-condensed");
6555 staticpro (&Qultra_condensed
);
6556 Qextra_condensed
= intern ("extra-condensed");
6557 staticpro (&Qextra_condensed
);
6558 Qcondensed
= intern ("condensed");
6559 staticpro (&Qcondensed
);
6560 Qsemi_condensed
= intern ("semi-condensed");
6561 staticpro (&Qsemi_condensed
);
6562 Qsemi_expanded
= intern ("semi-expanded");
6563 staticpro (&Qsemi_expanded
);
6564 Qexpanded
= intern ("expanded");
6565 staticpro (&Qexpanded
);
6566 Qextra_expanded
= intern ("extra-expanded");
6567 staticpro (&Qextra_expanded
);
6568 Qultra_expanded
= intern ("ultra-expanded");
6569 staticpro (&Qultra_expanded
);
6570 Qbackground_color
= intern ("background-color");
6571 staticpro (&Qbackground_color
);
6572 Qforeground_color
= intern ("foreground-color");
6573 staticpro (&Qforeground_color
);
6574 Qunspecified
= intern ("unspecified");
6575 staticpro (&Qunspecified
);
6577 Qx_charset_registry
= intern ("x-charset-registry");
6578 staticpro (&Qx_charset_registry
);
6579 Qface_alias
= intern ("face-alias");
6580 staticpro (&Qface_alias
);
6581 Qdefault
= intern ("default");
6582 staticpro (&Qdefault
);
6583 Qmode_line
= intern ("mode-line");
6584 staticpro (&Qmode_line
);
6585 Qtool_bar
= intern ("tool-bar");
6586 staticpro (&Qtool_bar
);
6587 Qregion
= intern ("region");
6588 staticpro (&Qregion
);
6589 Qfringe
= intern ("fringe");
6590 staticpro (&Qfringe
);
6591 Qheader_line
= intern ("header-line");
6592 staticpro (&Qheader_line
);
6593 Qscroll_bar
= intern ("scroll-bar");
6594 staticpro (&Qscroll_bar
);
6595 Qmenu
= intern ("menu");
6597 Qcursor
= intern ("cursor");
6598 staticpro (&Qcursor
);
6599 Qborder
= intern ("border");
6600 staticpro (&Qborder
);
6601 Qmouse
= intern ("mouse");
6602 staticpro (&Qmouse
);
6604 defsubr (&Sinternal_make_lisp_face
);
6605 defsubr (&Sinternal_lisp_face_p
);
6606 defsubr (&Sinternal_set_lisp_face_attribute
);
6607 #ifdef HAVE_X_WINDOWS
6608 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6609 defsubr (&Sface_color_gray_p
);
6610 defsubr (&Sface_color_supported_p
);
6612 defsubr (&Sinternal_get_lisp_face_attribute
);
6613 defsubr (&Sinternal_lisp_face_attribute_values
);
6614 defsubr (&Sinternal_lisp_face_equal_p
);
6615 defsubr (&Sinternal_lisp_face_empty_p
);
6616 defsubr (&Sinternal_copy_lisp_face
);
6617 defsubr (&Sinternal_merge_in_global_face
);
6618 defsubr (&Sface_font
);
6619 defsubr (&Sframe_face_alist
);
6620 defsubr (&Sinternal_set_font_selection_order
);
6621 defsubr (&Sinternal_set_alternative_font_family_alist
);
6623 defsubr (&Sdump_face
);
6624 defsubr (&Sshow_face_resources
);
6625 #endif /* GLYPH_DEBUG */
6626 defsubr (&Sclear_face_cache
);
6628 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6629 "*Limit for font matching.\n\
6630 If an integer > 0, font matching functions won't load more than\n\
6631 that number of fonts when searching for a matching font.");
6632 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6634 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6635 "List of global face definitions (for internal use only.)");
6636 Vface_new_frame_defaults
= Qnil
;
6638 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6639 "*Default stipple pattern used on monochrome displays.\n\
6640 This stipple pattern is used on monochrome displays\n\
6641 instead of shades of gray for a face background color.\n\
6642 See `set-face-stipple' for possible values for this variable.");
6643 Vface_default_stipple
= build_string ("gray3");
6645 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6646 "Default registry and encoding to use.\n\
6647 This registry and encoding is used for unibyte text. It is set up\n\
6648 from the specified frame font when Emacs starts. (For internal use only.)");
6649 Vface_default_registry
= Qnil
;
6651 DEFVAR_LISP ("face-alternative-font-family-alist",
6652 &Vface_alternative_font_family_alist
, "");
6653 Vface_alternative_font_family_alist
= Qnil
;
6657 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6658 "Allowed scalable fonts.\n\
6659 A value of nil means don't allow any scalable fonts.\n\
6660 A value of t means allow any scalable font.\n\
6661 Otherwise, value must be a list of regular expressions. A font may be\n\
6662 scaled if its name matches a regular expression in the list.");
6663 Vscalable_fonts_allowed
= Qnil
;
6665 #endif /* SCALABLE_FONTS */
6667 #ifdef HAVE_X_WINDOWS
6668 defsubr (&Sbitmap_spec_p
);
6669 defsubr (&Sx_list_fonts
);
6670 defsubr (&Sinternal_face_x_get_resource
);
6671 defsubr (&Sx_family_fonts
);
6672 defsubr (&Sx_font_family_list
);
6673 #endif /* HAVE_X_WINDOWS */
6675 /* TTY face support. */
6676 defsubr (&Sface_register_tty_color
);
6677 defsubr (&Sface_clear_tty_colors
);
6678 defsubr (&Stty_defined_colors
);
6679 Vface_tty_color_alist
= Qnil
;
6680 staticpro (&Vface_tty_color_alist
);