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
180 #include <sys/types.h>
181 #include <sys/stat.h>
187 #ifdef HAVE_X_WINDOWS
197 #include "dispextern.h"
198 #include "blockinput.h"
200 #include "intervals.h"
202 #ifdef HAVE_X_WINDOWS
204 /* Compensate for a bug in Xos.h on some systems, on which it requires
205 time.h. On some such systems, Xos.h tries to redefine struct
206 timeval and struct timezone if USG is #defined while it is
209 #ifdef XOS_NEEDS_TIME_H
215 #else /* not XOS_NEEDS_TIME_H */
217 #endif /* not XOS_NEEDS_TIME_H */
219 #endif /* HAVE_X_WINDOWS */
224 #include "keyboard.h"
227 #define max(A, B) ((A) > (B) ? (A) : (B))
228 #define min(A, B) ((A) < (B) ? (A) : (B))
229 #define abs(X) ((X) < 0 ? -(X) : (X))
232 /* Non-zero if face attribute ATTR is unspecified. */
234 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
236 /* Value is the number of elements of VECTOR. */
238 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
240 /* Make a copy of string S on the stack using alloca. Value is a pointer
243 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
245 /* Make a copy of the contents of Lisp string S on the stack using
246 alloca. Value is a pointer to the copy. */
248 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
250 /* Size of hash table of realized faces in face caches (should be a
253 #define FACE_CACHE_BUCKETS_SIZE 1001
255 /* Keyword symbols used for face attribute names. */
257 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
258 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
259 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
260 Lisp_Object QCreverse_video
;
261 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
263 /* Symbols used for attribute values. */
265 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
266 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
267 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
268 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
269 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
270 Lisp_Object Qultra_expanded
;
271 Lisp_Object Qreleased_button
, Qpressed_button
;
272 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
273 Lisp_Object Qunspecified
;
275 /* The symbol `x-charset-registry'. This property of charsets defines
276 the X registry and encoding that fonts should have that are used to
277 display characters of that charset. */
279 Lisp_Object Qx_charset_registry
;
281 /* The name of the function to call when the background of the frame
282 has changed, frame_update_face_colors. */
284 Lisp_Object Qframe_update_face_colors
;
286 /* Names of basic faces. */
288 Lisp_Object Qdefault
, Qmode_line
, Qtool_bar
, Qregion
, Qfringe
;
289 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
;;
291 /* The symbol `face-alias'. A symbols having that property is an
292 alias for another face. Value of the property is the name of
295 Lisp_Object Qface_alias
;
297 /* Names of frame parameters related to faces. */
299 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
300 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
302 /* Default stipple pattern used on monochrome displays. This stipple
303 pattern is used on monochrome displays instead of shades of gray
304 for a face background color. See `set-face-stipple' for possible
305 values for this variable. */
307 Lisp_Object Vface_default_stipple
;
309 /* Default registry and encoding to use for charsets whose charset
310 symbols don't specify one. */
312 Lisp_Object Vface_default_registry
;
314 /* Alist of alternative font families. Each element is of the form
315 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
316 try FAMILY1, then FAMILY2, ... */
318 Lisp_Object Vface_alternative_font_family_alist
;
320 /* Allowed scalable fonts. A value of nil means don't allow any
321 scalable fonts. A value of t means allow the use of any scalable
322 font. Otherwise, value must be a list of regular expressions. A
323 font may be scaled if its name matches a regular expression in the
327 Lisp_Object Vscalable_fonts_allowed
;
330 /* Maximum number of fonts to consider in font_list. If not an
331 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
333 Lisp_Object Vfont_list_limit
;
334 #define DEFAULT_FONT_LIST_LIMIT 100
336 /* The symbols `foreground-color' and `background-color' which can be
337 used as part of a `face' property. This is for compatibility with
340 Lisp_Object Qforeground_color
, Qbackground_color
;
342 /* The symbols `face' and `mouse-face' used as text properties. */
345 extern Lisp_Object Qmouse_face
;
347 /* Error symbol for wrong_type_argument in load_pixmap. */
349 Lisp_Object Qpixmap_spec_p
;
351 /* Alist of global face definitions. Each element is of the form
352 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
353 is a Lisp vector of face attributes. These faces are used
354 to initialize faces for new frames. */
356 Lisp_Object Vface_new_frame_defaults
;
358 /* The next ID to assign to Lisp faces. */
360 static int next_lface_id
;
362 /* A vector mapping Lisp face Id's to face names. */
364 static Lisp_Object
*lface_id_to_name
;
365 static int lface_id_to_name_size
;
367 /* An alist of elements (COLOR-NAME . INDEX) mapping color names
368 to color indices for tty frames. */
370 Lisp_Object Vface_tty_color_alist
;
372 /* Counter for calls to clear_face_cache. If this counter reaches
373 CLEAR_FONT_TABLE_COUNT, and a frame has more than
374 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
376 static int clear_font_table_count
;
377 #define CLEAR_FONT_TABLE_COUNT 100
378 #define CLEAR_FONT_TABLE_NFONTS 10
380 /* Non-zero means face attributes have been changed since the last
381 redisplay. Used in redisplay_internal. */
383 int face_change_count
;
385 /* The total number of colors currently allocated. */
388 static int ncolors_allocated
;
389 static int npixmaps_allocated
;
395 /* Function prototypes. */
400 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
401 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
402 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
404 static int first_font_matching
P_ ((struct frame
*f
, char *,
405 struct font_name
*));
406 static int x_face_list_fonts
P_ ((struct frame
*, char *,
407 struct font_name
*, int, int, int));
408 static int font_scalable_p
P_ ((struct font_name
*));
409 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
410 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
411 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
412 static char *xstrdup
P_ ((char *));
413 static unsigned char *xstrlwr
P_ ((unsigned char *));
414 static void signal_error
P_ ((char *, Lisp_Object
));
415 static void add_to_log
P_ ((struct frame
*, char *, Lisp_Object
, Lisp_Object
));
416 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
417 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
418 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
419 static void free_face_colors
P_ ((struct frame
*, struct face
*));
420 static int face_color_gray_p
P_ ((struct frame
*, char *));
421 static char *build_font_name
P_ ((struct font_name
*));
422 static void free_font_names
P_ ((struct font_name
*, int));
423 static int sorted_font_list
P_ ((struct frame
*, char *,
424 int (*cmpfn
) P_ ((const void *, const void *)),
425 struct font_name
**));
426 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
427 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
428 struct font_name
**));
429 static int cmp_font_names
P_ ((const void *, const void *));
430 static struct face
*realize_face
P_ ((struct face_cache
*,
431 Lisp_Object
*, int));
432 static struct face
*realize_x_face
P_ ((struct face_cache
*,
433 Lisp_Object
*, int));
434 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
435 Lisp_Object
*, int));
436 static int realize_basic_faces
P_ ((struct frame
*));
437 static int realize_default_face
P_ ((struct frame
*));
438 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
439 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
440 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
441 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
442 static unsigned lface_hash
P_ ((Lisp_Object
*));
443 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
444 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
445 static void free_realized_face
P_ ((struct frame
*, struct face
*));
446 static void clear_face_gcs
P_ ((struct face_cache
*));
447 static void free_face_cache
P_ ((struct face_cache
*));
448 static int face_numeric_weight
P_ ((Lisp_Object
));
449 static int face_numeric_slant
P_ ((Lisp_Object
));
450 static int face_numeric_swidth
P_ ((Lisp_Object
));
451 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
452 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
454 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
456 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
457 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
459 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
461 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
462 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
463 static void free_realized_faces
P_ ((struct face_cache
*));
464 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
465 struct font_name
*, int));
466 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
467 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
468 static int xlfd_numeric_slant
P_ ((struct font_name
*));
469 static int xlfd_numeric_weight
P_ ((struct font_name
*));
470 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
471 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
472 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
473 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
474 static int xlfd_fixed_p
P_ ((struct font_name
*));
475 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
477 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
478 struct font_name
*, int, int));
479 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
480 struct font_name
*, int));
482 #ifdef HAVE_X_WINDOWS
484 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
485 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
486 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
487 int (*cmpfn
) P_ ((const void *, const void *))));
488 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
489 static void x_free_gc
P_ ((struct frame
*, GC
));
490 static void clear_font_table
P_ ((struct frame
*));
492 #endif /* HAVE_X_WINDOWS */
495 /***********************************************************************
497 ***********************************************************************/
499 #ifdef HAVE_X_WINDOWS
501 /* Create and return a GC for use on frame F. GC values and mask
502 are given by XGCV and MASK. */
505 x_create_gc (f
, mask
, xgcv
)
512 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
519 /* Free GC which was used on frame F. */
527 xassert (--ngcs
>= 0);
528 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
532 #endif /* HAVE_X_WINDOWS */
535 /* Like strdup, but uses xmalloc. */
541 int len
= strlen (s
) + 1;
542 char *p
= (char *) xmalloc (len
);
548 /* Like stricmp. Used to compare parts of font names which are in
553 unsigned char *s1
, *s2
;
557 unsigned char c1
= tolower (*s1
);
558 unsigned char c2
= tolower (*s2
);
560 return c1
< c2
? -1 : 1;
565 return *s2
== 0 ? 0 : -1;
570 /* Like strlwr, which might not always be available. */
572 static unsigned char *
576 unsigned char *p
= s
;
585 /* Signal `error' with message S, and additional argument ARG. */
588 signal_error (s
, arg
)
592 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
596 /* Display a message with format string FORMAT and arguments ARG1 and
597 ARG2 on frame F. Used to display errors if fonts, bitmaps, colors
598 etc. for a realized face on frame F cannot be loaded. (If we would
599 signal an error in these cases, we would end up in an infinite
600 recursion because this would stop realization, and the redisplay
601 triggered by the signal would try to realize that same face again.)
603 If basic faces of F are not realized, just add the message to the
604 messages buffer "*Messages*". Because Fmessage calls
605 echo_area_display which tries to realize basic faces again, we would
606 otherwise also end in an infinite recursion. */
609 add_to_log (f
, format
, arg1
, arg2
)
612 Lisp_Object arg1
, arg2
;
618 extern int waiting_for_input
;
620 /* Function note_mouse_highlight calls face_at_buffer_position which
621 may realize a face. If some attribute of that face is invalid,
622 say an invalid color, don't display an error to avoid calling
623 Lisp from XTread_socket. */
624 if (waiting_for_input
)
627 nargs
= make_number (DIM (args
));
628 args
[0] = build_string (format
);
631 msg
= Fformat (nargs
, args
);
633 /* Log the error, but don't display it in the echo area. This
634 proves to be annoying in many cases. */
635 buffer
= LSTRDUPA (msg
);
636 message_dolog (buffer
, strlen (buffer
), 1, 0);
640 /* If FRAME is nil, return a pointer to the selected frame.
641 Otherwise, check that FRAME is a live frame, and return a pointer
642 to it. NPARAM is the parameter number of FRAME, for
643 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
644 Lisp function definitions. */
646 static INLINE
struct frame
*
647 frame_or_selected_frame (frame
, nparam
)
652 frame
= selected_frame
;
654 CHECK_LIVE_FRAME (frame
, nparam
);
655 return XFRAME (frame
);
659 /***********************************************************************
661 ***********************************************************************/
663 /* Initialize face cache and basic faces for frame F. */
669 /* Make a face cache, if F doesn't have one. */
670 if (FRAME_FACE_CACHE (f
) == NULL
)
671 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
673 #ifdef HAVE_X_WINDOWS
674 /* Make the image cache. */
677 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
678 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
679 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
681 #endif /* HAVE_X_WINDOWS */
683 /* Realize basic faces. Must have enough information in frame
684 parameters to realize basic faces at this point. */
685 #ifdef HAVE_X_WINDOWS
686 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
688 if (!realize_basic_faces (f
))
693 /* Free face cache of frame F. Called from Fdelete_frame. */
699 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
703 free_face_cache (face_cache
);
704 FRAME_FACE_CACHE (f
) = NULL
;
707 #ifdef HAVE_X_WINDOWS
710 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
713 --image_cache
->refcount
;
714 if (image_cache
->refcount
== 0)
715 free_image_cache (f
);
718 #endif /* HAVE_X_WINDOWS */
722 /* Clear face caches, and recompute basic faces for frame F. Call
723 this after changing frame parameters on which those faces depend,
724 or when realized faces have been freed due to changing attributes
728 recompute_basic_faces (f
)
731 if (FRAME_FACE_CACHE (f
))
734 clear_face_cache (0);
735 realized_p
= realize_basic_faces (f
);
736 xassert (realized_p
);
741 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
742 try to free unused fonts, too. */
745 clear_face_cache (clear_fonts_p
)
748 #ifdef HAVE_X_WINDOWS
749 Lisp_Object tail
, frame
;
753 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
755 /* From time to time see if we can unload some fonts. This also
756 frees all realized faces on all frames. Fonts needed by
757 faces will be loaded again when faces are realized again. */
758 clear_font_table_count
= 0;
760 FOR_EACH_FRAME (tail
, frame
)
764 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
766 free_all_realized_faces (frame
);
767 clear_font_table (f
);
773 /* Clear GCs of realized faces. */
774 FOR_EACH_FRAME (tail
, frame
)
779 clear_face_gcs (FRAME_FACE_CACHE (f
));
780 clear_image_cache (f
, 0);
784 #endif /* HAVE_X_WINDOWS */
788 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
789 "Clear face caches on all frames.\n\
790 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
792 Lisp_Object thorougly
;
794 clear_face_cache (!NILP (thorougly
));
800 #ifdef HAVE_X_WINDOWS
803 /* Remove those fonts from the font table of frame F that are not used
804 by fontsets. Called from clear_face_cache from time to time. */
810 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
812 Lisp_Object rest
, frame
;
815 xassert (FRAME_X_P (f
));
817 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
818 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
820 /* For all frames with the same x_display_info as F, record
821 in `used' those fonts that are in use by fontsets. */
822 FOR_EACH_FRAME (rest
, frame
)
823 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
825 struct frame
*f
= XFRAME (frame
);
826 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
828 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
830 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
833 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
835 int idx
= info
->font_indexes
[j
];
842 /* Free those fonts that are not used by fontsets. */
843 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
844 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
846 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
848 /* Free names. In xfns.c there is a comment that full_name
849 should never be freed because it is always shared with
850 something else. I don't think this is true anymore---see
851 x_load_font. It's either equal to font_info->name or
852 allocated via xmalloc, and there seems to be no place in
853 the source files where full_name is transferred to another
855 if (font_info
->full_name
!= font_info
->name
)
856 xfree (font_info
->full_name
);
857 xfree (font_info
->name
);
861 XFreeFont (dpyinfo
->display
, font_info
->font
);
864 /* Mark font table slot free. */
865 font_info
->font
= NULL
;
866 font_info
->name
= font_info
->full_name
= NULL
;
871 #endif /* HAVE_X_WINDOWS */
875 /***********************************************************************
877 ***********************************************************************/
879 #ifdef HAVE_X_WINDOWS
881 DEFUN ("pixmap-spec-p", Fpixmap_spec_p
, Spixmap_spec_p
, 1, 1, 0,
882 "Non-nil if OBJECT is a valid pixmap specification.\n\
883 A pixmap specification is either a string, or a list (WIDTH HEIGHT DATA)\n\
884 where WIDTH is the pixel width of the pixmap, HEIGHT is its height,\n\
885 and DATA contains the bits of the pixmap.")
889 Lisp_Object height
, width
;
891 return ((STRINGP (object
)
893 && CONSP (XCONS (object
)->cdr
)
894 && CONSP (XCONS (XCONS (object
)->cdr
)->cdr
)
895 && NILP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->cdr
)
896 && (width
= XCONS (object
)->car
, INTEGERP (width
))
897 && (height
= XCONS (XCONS (object
)->cdr
)->car
,
899 && STRINGP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)
902 /* The string must have enough bits for width * height. */
903 && ((XSTRING (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)->size
904 * (BITS_PER_INT
/ sizeof (int)))
905 >= XFASTINT (width
) * XFASTINT (height
))))
910 /* Load a bitmap according to NAME (which is either a file name or a
911 pixmap spec) for use on frame F. Value is the bitmap_id (see
912 xfns.c). If NAME is nil, return with a bitmap id of zero. If
913 bitmap cannot be loaded, display a message saying so, and return
914 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
915 if these pointers are not null. */
918 load_pixmap (f
, name
, w_ptr
, h_ptr
)
921 unsigned int *w_ptr
, *h_ptr
;
929 tem
= Fpixmap_spec_p (name
);
931 wrong_type_argument (Qpixmap_spec_p
, name
);
936 /* Decode a bitmap spec into a bitmap. */
941 w
= XINT (Fcar (name
));
942 h
= XINT (Fcar (Fcdr (name
)));
943 bits
= Fcar (Fcdr (Fcdr (name
)));
945 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
950 /* It must be a string -- a file name. */
951 bitmap_id
= x_create_bitmap_from_file (f
, name
);
957 add_to_log (f
, "Invalid or undefined bitmap %s", name
, Qnil
);
968 ++npixmaps_allocated
;
971 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
974 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
980 #endif /* HAVE_X_WINDOWS */
984 /***********************************************************************
986 ***********************************************************************/
988 #ifdef HAVE_X_WINDOWS
990 /* Update the line_height of frame F. Return non-zero if line height
994 frame_update_line_height (f
)
997 int fontset
, line_height
, changed_p
;
999 fontset
= f
->output_data
.x
->fontset
;
1001 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
1003 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
1005 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
1006 f
->output_data
.x
->line_height
= line_height
;
1010 #endif /* HAVE_X_WINDOWS */
1013 /***********************************************************************
1015 ***********************************************************************/
1017 #ifdef HAVE_X_WINDOWS
1019 /* Load font or fontset of face FACE which is used on frame F.
1020 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1021 fontset. FONT_NAME is the name of the font to load, if no fontset
1022 is used. It is null if no suitable font name could be determined
1026 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1032 struct font_info
*font_info
= NULL
;
1034 face
->font_info_id
= -1;
1035 face
->fontset
= fontset
;
1040 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1043 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1052 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1053 face
->font
= font_info
->font
;
1054 face
->font_name
= font_info
->full_name
;
1056 /* Make the registry part of the font name readily accessible.
1057 The registry is used to find suitable faces for unibyte text. */
1058 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1060 while (i
< 2 && --s
>= font_info
->full_name
)
1064 if (!STRINGP (face
->registry
)
1065 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1067 if (STRINGP (Vface_default_registry
)
1068 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1069 face
->registry
= Vface_default_registry
;
1071 face
->registry
= build_string (s
+ 1);
1074 else if (fontset
>= 0)
1075 add_to_log (f
, "Unable to load ASCII font of fontset %d",
1076 make_number (fontset
), Qnil
);
1078 add_to_log (f
, "Unable to load font %s",
1079 build_string (font_name
), Qnil
);
1082 #endif /* HAVE_X_WINDOWS */
1086 /***********************************************************************
1088 ***********************************************************************/
1090 #ifdef HAVE_X_WINDOWS
1092 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1093 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1096 face_color_gray_p (f
, color_name
)
1103 if (defined_color (f
, color_name
, &color
, 0))
1104 gray_p
= ((abs (color
.red
- color
.green
)
1105 < max (color
.red
, color
.green
) / 20)
1106 && (abs (color
.green
- color
.blue
)
1107 < max (color
.green
, color
.blue
) / 20)
1108 && (abs (color
.blue
- color
.red
)
1109 < max (color
.blue
, color
.red
) / 20));
1117 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1118 BACKGROUND_P non-zero means the color will be used as background
1122 face_color_supported_p (f
, color_name
, background_p
)
1129 XSETFRAME (frame
, f
);
1130 return (!NILP (Vwindow_system
)
1131 && (!NILP (Fx_display_color_p (frame
))
1132 || xstricmp (color_name
, "black") == 0
1133 || xstricmp (color_name
, "white") == 0
1135 && face_color_gray_p (f
, color_name
))
1136 || (!NILP (Fx_display_grayscale_p (frame
))
1137 && face_color_gray_p (f
, color_name
))));
1141 DEFUN ("face-color-gray-p", Fface_color_gray_p
, Sface_color_gray_p
, 1, 2, 0,
1142 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1143 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1144 If FRAME is nil or omitted, use the selected frame.")
1146 Lisp_Object color
, frame
;
1148 struct frame
*f
= check_x_frame (frame
);
1149 CHECK_STRING (color
, 0);
1150 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1154 DEFUN ("face-color-supported-p", Fface_color_supported_p
,
1155 Sface_color_supported_p
, 2, 3, 0,
1156 "Return non-nil if COLOR can be displayed on FRAME.\n\
1157 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1158 If FRAME is nil or omitted, use the selected frame.\n\
1159 COLOR must be a valid color name.")
1160 (frame
, color
, background_p
)
1161 Lisp_Object frame
, color
, background_p
;
1163 struct frame
*f
= check_x_frame (frame
);
1164 CHECK_STRING (color
, 0);
1165 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1170 /* Load color with name NAME for use by face FACE on frame F.
1171 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1172 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1173 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1174 pixel color. If color cannot be loaded, display a message, and
1175 return the foreground, background or underline color of F, but
1176 record that fact in flags of the face so that we don't try to free
1180 load_color (f
, face
, name
, target_index
)
1184 enum lface_attribute_index target_index
;
1188 xassert (STRINGP (name
));
1189 xassert (target_index
== LFACE_FOREGROUND_INDEX
1190 || target_index
== LFACE_BACKGROUND_INDEX
1191 || target_index
== LFACE_UNDERLINE_INDEX
1192 || target_index
== LFACE_OVERLINE_INDEX
1193 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1194 || target_index
== LFACE_BOX_INDEX
);
1196 /* if the color map is full, defined_color will return a best match
1197 to the values in an existing cell. */
1198 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1200 add_to_log (f
, "Unable to load color %s", name
, Qnil
);
1202 switch (target_index
)
1204 case LFACE_FOREGROUND_INDEX
:
1205 face
->foreground_defaulted_p
= 1;
1206 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1209 case LFACE_BACKGROUND_INDEX
:
1210 face
->background_defaulted_p
= 1;
1211 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1214 case LFACE_UNDERLINE_INDEX
:
1215 face
->underline_defaulted_p
= 1;
1216 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1219 case LFACE_OVERLINE_INDEX
:
1220 face
->overline_color_defaulted_p
= 1;
1221 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1224 case LFACE_STRIKE_THROUGH_INDEX
:
1225 face
->strike_through_color_defaulted_p
= 1;
1226 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1229 case LFACE_BOX_INDEX
:
1230 face
->box_color_defaulted_p
= 1;
1231 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1240 ++ncolors_allocated
;
1247 /* Load colors for face FACE which is used on frame F. Colors are
1248 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1249 of ATTRS. If the background color specified is not supported on F,
1250 try to emulate gray colors with a stipple from Vface_default_stipple. */
1253 load_face_colors (f
, face
, attrs
)
1260 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1261 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1263 /* Swap colors if face is inverse-video. */
1264 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1272 /* Check for support for foreground, not for background because
1273 face_color_supported_p is smart enough to know that grays are
1274 "supported" as background because we are supposed to use stipple
1276 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1277 && !NILP (Fpixmap_spec_p (Vface_default_stipple
)))
1279 x_destroy_bitmap (f
, face
->stipple
);
1280 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1281 &face
->pixmap_w
, &face
->pixmap_h
);
1284 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1285 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1289 /* Free color PIXEL on frame F. */
1292 unload_color (f
, pixel
)
1294 unsigned long pixel
;
1296 Display
*dpy
= FRAME_X_DISPLAY (f
);
1297 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1299 if (pixel
== BLACK_PIX_DEFAULT (f
)
1300 || pixel
== WHITE_PIX_DEFAULT (f
))
1305 /* If display has an immutable color map, freeing colors is not
1306 necessary and some servers don't allow it. So don't do it. */
1307 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1309 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1310 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1317 /* Free colors allocated for FACE. */
1320 free_face_colors (f
, face
)
1324 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1326 /* If display has an immutable color map, freeing colors is not
1327 necessary and some servers don't allow it. So don't do it. */
1328 if (class != StaticColor
1329 && class != StaticGray
1330 && class != TrueColor
)
1336 dpy
= FRAME_X_DISPLAY (f
);
1337 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1339 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1340 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1341 && !face
->foreground_defaulted_p
)
1343 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1344 IF_DEBUG (--ncolors_allocated
);
1347 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1348 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1349 && !face
->background_defaulted_p
)
1351 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1352 IF_DEBUG (--ncolors_allocated
);
1355 if (face
->underline_p
1356 && !face
->underline_defaulted_p
1357 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1358 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1360 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1361 IF_DEBUG (--ncolors_allocated
);
1364 if (face
->overline_p
1365 && !face
->overline_color_defaulted_p
1366 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1367 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1369 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1370 IF_DEBUG (--ncolors_allocated
);
1373 if (face
->strike_through_p
1374 && !face
->strike_through_color_defaulted_p
1375 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1376 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1378 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1379 IF_DEBUG (--ncolors_allocated
);
1382 if (face
->box
!= FACE_NO_BOX
1383 && !face
->box_color_defaulted_p
1384 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1385 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1387 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1388 IF_DEBUG (--ncolors_allocated
);
1395 #else /* ! HAVE_X_WINDOWS */
1399 load_color (f
, face
, name
, target_index
)
1403 enum lface_attribute_index target_index
;
1406 int color_idx
= FACE_TTY_DEFAULT_COLOR
;
1409 return (unsigned long)FACE_TTY_DEFAULT_COLOR
;
1411 CHECK_STRING (name
, 0);
1414 if (XSTRING (name
)->size
&& !NILP (Ffboundp (Qmsdos_color_translate
)))
1416 color
= call1 (Qmsdos_color_translate
, name
);
1418 if (INTEGERP (color
))
1419 return (unsigned long)XINT (color
);
1421 add_to_log (f
, "Unable to load color %s", name
, Qnil
);
1423 switch (target_index
)
1425 case LFACE_FOREGROUND_INDEX
:
1426 face
->foreground_defaulted_p
= 1;
1427 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1430 case LFACE_BACKGROUND_INDEX
:
1431 face
->background_defaulted_p
= 1;
1432 color_idx
= FRAME_BACKGROUND_PIXEL (f
);
1435 case LFACE_UNDERLINE_INDEX
:
1436 face
->underline_defaulted_p
= 1;
1437 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1440 case LFACE_OVERLINE_INDEX
:
1441 face
->overline_color_defaulted_p
= 1;
1442 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1445 case LFACE_STRIKE_THROUGH_INDEX
:
1446 face
->strike_through_color_defaulted_p
= 1;
1447 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1450 case LFACE_BOX_INDEX
:
1451 face
->box_color_defaulted_p
= 1;
1452 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1457 color_idx
= msdos_stdcolor_idx (XSTRING (name
)->data
);
1459 return (unsigned long)color_idx
;
1462 #endif /* ! HAVE_X_WINDOWS */
1466 /***********************************************************************
1468 ***********************************************************************/
1470 /* An enumerator for each field of an XLFD font name. */
1491 /* An enumerator for each possible slant value of a font. Taken from
1492 the XLFD specification. */
1500 XLFD_SLANT_REVERSE_ITALIC
,
1501 XLFD_SLANT_REVERSE_OBLIQUE
,
1505 /* Relative font weight according to XLFD documentation. */
1509 XLFD_WEIGHT_UNKNOWN
,
1510 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1511 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1512 XLFD_WEIGHT_LIGHT
, /* 30 */
1513 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1514 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1515 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1516 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1517 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1518 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1521 /* Relative proportionate width. */
1525 XLFD_SWIDTH_UNKNOWN
,
1526 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1527 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1528 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1529 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1530 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1531 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1532 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1533 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1534 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1537 /* Structure used for tables mapping XLFD weight, slant, and width
1538 names to numeric and symbolic values. */
1544 Lisp_Object
*symbol
;
1547 /* Table of XLFD slant names and their numeric and symbolic
1548 representations. This table must be sorted by slant names in
1551 static struct table_entry slant_table
[] =
1553 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1554 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1555 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1556 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1557 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1558 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1561 /* Table of XLFD weight names. This table must be sorted by weight
1562 names in ascending order. */
1564 static struct table_entry weight_table
[] =
1566 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1567 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1568 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1569 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1570 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1571 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1572 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1573 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1574 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1575 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1576 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1577 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1578 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1579 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1580 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1583 /* Table of XLFD width names. This table must be sorted by width
1584 names in ascending order. */
1586 static struct table_entry swidth_table
[] =
1588 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1589 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1590 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1591 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1592 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1593 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1594 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1595 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1596 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1597 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1598 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1599 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1600 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1601 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1602 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1605 /* Structure used to hold the result of splitting font names in XLFD
1606 format into their fields. */
1610 /* The original name which is modified destructively by
1611 split_font_name. The pointer is kept here to be able to free it
1612 if it was allocated from the heap. */
1615 /* Font name fields. Each vector element points into `name' above.
1616 Fields are NUL-terminated. */
1617 char *fields
[XLFD_LAST
];
1619 /* Numeric values for those fields that interest us. See
1620 split_font_name for which these are. */
1621 int numeric
[XLFD_LAST
];
1624 /* The frame in effect when sorting font names. Set temporarily in
1625 sort_fonts so that it is available in font comparison functions. */
1627 static struct frame
*font_frame
;
1629 /* Order by which font selection chooses fonts. The default values
1630 mean `first, find a best match for the font width, then for the
1631 font height, then for weight, then for slant.' This variable can be
1632 set via set-face-font-sort-order. */
1634 static int font_sort_order
[4];
1637 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1638 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1639 is a pointer to the matching table entry or null if no table entry
1642 static struct table_entry
*
1643 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1644 struct table_entry
*table
;
1646 struct font_name
*font
;
1649 /* Function split_font_name converts fields to lower-case, so there
1650 is no need to use xstrlwr or xstricmp here. */
1651 char *s
= font
->fields
[field_index
];
1652 int low
, mid
, high
, cmp
;
1659 mid
= (low
+ high
) / 2;
1660 cmp
= strcmp (table
[mid
].name
, s
);
1674 /* Return a numeric 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 numeric 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 numeric values. */
1681 xlfd_numeric_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
->numeric
: dflt
;
1694 /* Return a symbolic representation for font name field
1695 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1696 has DIM entries. Value is the symbolic value found or DFLT if no
1697 table entry matches. This function is used to translate weight,
1698 slant, and swidth names of XLFD font names to symbols. */
1700 static INLINE Lisp_Object
1701 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1702 struct table_entry
*table
;
1704 struct font_name
*font
;
1708 struct table_entry
*p
;
1709 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1710 return p
? *p
->symbol
: dflt
;
1714 /* Return a numeric value for the slant of the font given by FONT. */
1717 xlfd_numeric_slant (font
)
1718 struct font_name
*font
;
1720 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1721 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1725 /* Return a symbol representing the weight of the font given by FONT. */
1727 static INLINE Lisp_Object
1728 xlfd_symbolic_slant (font
)
1729 struct font_name
*font
;
1731 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1732 font
, XLFD_SLANT
, Qnormal
);
1736 /* Return a numeric value for the weight of the font given by FONT. */
1739 xlfd_numeric_weight (font
)
1740 struct font_name
*font
;
1742 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1743 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1747 /* Return a symbol representing the slant of the font given by FONT. */
1749 static INLINE Lisp_Object
1750 xlfd_symbolic_weight (font
)
1751 struct font_name
*font
;
1753 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1754 font
, XLFD_WEIGHT
, Qnormal
);
1758 /* Return a numeric value for the swidth of the font whose XLFD font
1759 name fields are found in FONT. */
1762 xlfd_numeric_swidth (font
)
1763 struct font_name
*font
;
1765 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1766 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1770 /* Return a symbolic value for the swidth of FONT. */
1772 static INLINE Lisp_Object
1773 xlfd_symbolic_swidth (font
)
1774 struct font_name
*font
;
1776 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1777 font
, XLFD_SWIDTH
, Qnormal
);
1781 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1782 entries. Value is a pointer to the matching table entry or null if
1783 no element of TABLE contains SYMBOL. */
1785 static struct table_entry
*
1786 face_value (table
, dim
, symbol
)
1787 struct table_entry
*table
;
1793 xassert (SYMBOLP (symbol
));
1795 for (i
= 0; i
< dim
; ++i
)
1796 if (EQ (*table
[i
].symbol
, symbol
))
1799 return i
< dim
? table
+ i
: NULL
;
1803 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1804 entries. Value is -1 if SYMBOL is not found in TABLE. */
1807 face_numeric_value (table
, dim
, symbol
)
1808 struct table_entry
*table
;
1812 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1813 return p
? p
->numeric
: -1;
1817 /* Return a numeric value representing the weight specified by Lisp
1818 symbol WEIGHT. Value is one of the enumerators of enum
1822 face_numeric_weight (weight
)
1825 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1829 /* Return a numeric value representing the slant specified by Lisp
1830 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1833 face_numeric_slant (slant
)
1836 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1840 /* Return a numeric value representing the swidth specified by Lisp
1841 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1844 face_numeric_swidth (width
)
1847 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1851 #ifdef HAVE_X_WINDOWS
1853 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1857 struct font_name
*font
;
1859 /* Function split_font_name converts fields to lower-case, so there
1860 is no need to use tolower here. */
1861 return *font
->fields
[XLFD_SPACING
] != 'p';
1865 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1867 The actual height of the font when displayed on F depends on the
1868 resolution of both the font and frame. For example, a 10pt font
1869 designed for a 100dpi display will display larger than 10pt on a
1870 75dpi display. (It's not unusual to use fonts not designed for the
1871 display one is using. For example, some intlfonts are available in
1872 72dpi versions, only.)
1874 Value is the real point size of FONT on frame F, or 0 if it cannot
1878 xlfd_point_size (f
, font
)
1880 struct font_name
*font
;
1882 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1883 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1884 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1887 if (font_resy
== 0 || font_pt
== 0)
1890 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1896 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1897 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1898 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1899 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1900 zero if the font name doesn't have the format we expect. The
1901 expected format is a font name that starts with a `-' and has
1902 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1903 forms of font names where certain field contents are enclosed in
1904 square brackets. We don't support that, for now. */
1907 split_font_name (f
, font
, numeric_p
)
1909 struct font_name
*font
;
1915 if (*font
->name
== '-')
1917 char *p
= xstrlwr (font
->name
) + 1;
1919 while (i
< XLFD_LAST
)
1921 font
->fields
[i
] = p
;
1924 while (*p
&& *p
!= '-')
1934 success_p
= i
== XLFD_LAST
;
1936 /* If requested, and font name was in the expected format,
1937 compute numeric values for some fields. */
1938 if (numeric_p
&& success_p
)
1940 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1941 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1942 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1943 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1944 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
1951 /* Build an XLFD font name from font name fields in FONT. Value is a
1952 pointer to the font name, which is allocated via xmalloc. */
1955 build_font_name (font
)
1956 struct font_name
*font
;
1960 char *font_name
= (char *) xmalloc (size
);
1961 int total_length
= 0;
1963 for (i
= 0; i
< XLFD_LAST
; ++i
)
1965 /* Add 1 because of the leading `-'. */
1966 int len
= strlen (font
->fields
[i
]) + 1;
1968 /* Reallocate font_name if necessary. Add 1 for the final
1970 if (total_length
+ len
+ 1 >= size
)
1972 int new_size
= max (2 * size
, size
+ len
+ 1);
1973 int sz
= new_size
* sizeof *font_name
;
1974 font_name
= (char *) xrealloc (font_name
, sz
);
1978 font_name
[total_length
] = '-';
1979 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
1980 total_length
+= len
;
1983 font_name
[total_length
] = 0;
1988 /* Free an array FONTS of N font_name structures. This frees FONTS
1989 itself and all `name' fields in its elements. */
1992 free_font_names (fonts
, n
)
1993 struct font_name
*fonts
;
1997 xfree (fonts
[--n
].name
);
2002 /* Sort vector FONTS of font_name structures which contains NFONTS
2003 elements using qsort and comparison function CMPFN. F is the frame
2004 on which the fonts will be used. The global variable font_frame
2005 is temporarily set to F to make it available in CMPFN. */
2008 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2010 struct font_name
*fonts
;
2012 int (*cmpfn
) P_ ((const void *, const void *));
2015 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2020 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2021 display in x_display_list. FONTS is a pointer to a vector of
2022 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2023 alternative patterns from Valternate_fontname_alist if no fonts are
2024 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2027 For all fonts found, set FONTS[i].name to the name of the font,
2028 allocated via xmalloc, and split font names into fields. Ignore
2029 fonts that we can't parse. Value is the number of fonts found.
2031 This is similar to x_list_fonts. The differences are:
2033 1. It avoids consing.
2034 2. It never calls XLoadQueryFont. */
2037 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2041 struct font_name
*fonts
;
2042 int nfonts
, try_alternatives_p
;
2043 int scalable_fonts_p
;
2045 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2049 /* Get the list of fonts matching PATTERN from the X server. */
2051 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2056 /* Make a copy of the font names we got from X, and
2057 split them into fields. */
2058 for (i
= j
= 0; i
< n
; ++i
)
2060 /* Make a copy of the font name. */
2061 fonts
[j
].name
= xstrdup (names
[i
]);
2063 /* Ignore fonts having a name that we can't parse. */
2064 if (!split_font_name (f
, fonts
+ j
, 1))
2065 xfree (fonts
[j
].name
);
2066 else if (font_scalable_p (fonts
+ j
))
2069 if (!scalable_fonts_p
2070 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2071 xfree (fonts
[j
].name
);
2074 #else /* !SCALABLE_FONTS */
2075 /* Always ignore scalable fonts. */
2076 xfree (fonts
[j
].name
);
2077 #endif /* !SCALABLE_FONTS */
2085 /* Free font names. */
2087 XFreeFontNames (names
);
2092 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2093 if (n
== 0 && try_alternatives_p
)
2095 Lisp_Object list
= Valternate_fontname_alist
;
2097 while (CONSP (list
))
2099 Lisp_Object entry
= XCAR (list
);
2101 && STRINGP (XCAR (entry
))
2102 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2109 Lisp_Object patterns
= XCAR (list
);
2112 while (CONSP (patterns
)
2113 /* If list is screwed up, give up. */
2114 && (name
= XCAR (patterns
),
2116 /* Ignore patterns equal to PATTERN because we tried that
2117 already with no success. */
2118 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2119 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2123 patterns
= XCDR (patterns
);
2131 /* Determine the first font matching PATTERN on frame F. Return in
2132 *FONT the matching font name, split into fields. Value is non-zero
2133 if a match was found. */
2136 first_font_matching (f
, pattern
, font
)
2139 struct font_name
*font
;
2142 struct font_name
*fonts
;
2144 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2145 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2149 bcopy (&fonts
[0], font
, sizeof *font
);
2151 fonts
[0].name
= NULL
;
2152 free_font_names (fonts
, nfonts
);
2159 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2160 using comparison function CMPFN. Value is the number of fonts
2161 found. If value is non-zero, *FONTS is set to a vector of
2162 font_name structures allocated from the heap containing matching
2163 fonts. Each element of *FONTS contains a name member that is also
2164 allocated from the heap. Font names in these structures are split
2165 into fields. Use free_font_names to free such an array. */
2168 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2171 int (*cmpfn
) P_ ((const void *, const void *));
2172 struct font_name
**fonts
;
2176 /* Get the list of fonts matching pattern. 100 should suffice. */
2177 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2178 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2179 nfonts
= XFASTINT (Vfont_list_limit
);
2181 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2183 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2185 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2188 /* Sort the resulting array and return it in *FONTS. If no
2189 fonts were found, make sure to set *FONTS to null. */
2191 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2202 /* Compare two font_name structures *A and *B. Value is analogous to
2203 strcmp. Sort order is given by the global variable
2204 font_sort_order. Font names are sorted so that, everything else
2205 being equal, fonts with a resolution closer to that of the frame on
2206 which they are used are listed first. The global variable
2207 font_frame is the frame on which we operate. */
2210 cmp_font_names (a
, b
)
2213 struct font_name
*x
= (struct font_name
*) a
;
2214 struct font_name
*y
= (struct font_name
*) b
;
2217 /* All strings have been converted to lower-case by split_font_name,
2218 so we can use strcmp here. */
2219 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2224 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2226 int j
= font_sort_order
[i
];
2227 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2232 /* Everything else being equal, we prefer fonts with an
2233 y-resolution closer to that of the frame. */
2234 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2235 int x_resy
= x
->numeric
[XLFD_RESY
];
2236 int y_resy
= y
->numeric
[XLFD_RESY
];
2237 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2245 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2246 is non-null list fonts matching that pattern. Otherwise, if
2247 REGISTRY_AND_ENCODING is non-null return only fonts with that
2248 registry and encoding, otherwise return fonts of any registry and
2249 encoding. Set *FONTS to a vector of font_name structures allocated
2250 from the heap containing the fonts found. Value is the number of
2254 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2258 char *registry_and_encoding
;
2259 struct font_name
**fonts
;
2261 if (pattern
== NULL
)
2266 if (registry_and_encoding
== NULL
)
2267 registry_and_encoding
= "*";
2269 pattern
= (char *) alloca (strlen (family
)
2270 + strlen (registry_and_encoding
)
2272 if (index (family
, '-'))
2273 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2275 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2278 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2282 /* Remove elements from LIST whose cars are `equal'. Called from
2283 x-family-fonts and x-font-family-list to remove duplicate font
2287 remove_duplicates (list
)
2290 Lisp_Object tail
= list
;
2292 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2294 Lisp_Object next
= XCDR (tail
);
2295 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2296 XCDR (tail
) = XCDR (next
);
2303 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2304 "Return a list of available fonts of family FAMILY on FRAME.\n\
2305 If FAMILY is omitted or nil, list all families.\n\
2306 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2308 If FRAME is omitted or nil, use the selected frame.\n\
2309 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2310 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2311 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2312 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2313 width, weight and slant of the font. These symbols are the same as for\n\
2314 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2315 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2316 giving the registry and encoding of the font.\n\
2317 The result list is sorted according to the current setting of\n\
2318 the face font sort order.")
2320 Lisp_Object family
, frame
;
2322 struct frame
*f
= check_x_frame (frame
);
2323 struct font_name
*fonts
;
2326 struct gcpro gcpro1
;
2327 char *family_pattern
;
2330 family_pattern
= "*";
2333 CHECK_STRING (family
, 1);
2334 family_pattern
= LSTRDUPA (family
);
2339 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2340 for (i
= nfonts
- 1; i
>= 0; --i
)
2342 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2345 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2347 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2348 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2349 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2350 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2351 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2352 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2353 tem
= build_font_name (fonts
+ i
);
2354 ASET (v
, 6, build_string (tem
));
2355 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2356 fonts
[i
].fields
[XLFD_ENCODING
]);
2357 ASET (v
, 7, build_string (tem
));
2360 result
= Fcons (v
, result
);
2365 remove_duplicates (result
);
2366 free_font_names (fonts
, nfonts
);
2372 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2374 "Return a list of available font families on FRAME.\n\
2375 If FRAME is omitted or nil, use the selected frame.\n\
2376 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2377 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2382 struct frame
*f
= check_x_frame (frame
);
2384 struct font_name
*fonts
;
2386 struct gcpro gcpro1
;
2387 int count
= specpdl_ptr
- specpdl
;
2390 /* Let's consider all fonts. Increase the limit for matching
2391 fonts until we have them all. */
2394 specbind (intern ("font-list-limit"), make_number (limit
));
2395 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2397 if (nfonts
== limit
)
2399 free_font_names (fonts
, nfonts
);
2408 for (i
= nfonts
- 1; i
>= 0; --i
)
2409 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2410 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2413 remove_duplicates (result
);
2414 free_font_names (fonts
, nfonts
);
2416 return unbind_to (count
, result
);
2420 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2421 "Return a list of the names of available fonts matching PATTERN.\n\
2422 If optional arguments FACE and FRAME are specified, return only fonts\n\
2423 the same size as FACE on FRAME.\n\
2424 PATTERN is a string, perhaps with wildcard characters;\n\
2425 the * character matches any substring, and\n\
2426 the ? character matches any single character.\n\
2427 PATTERN is case-insensitive.\n\
2428 FACE is a face name--a symbol.\n\
2430 The return value is a list of strings, suitable as arguments to\n\
2433 Fonts Emacs can't use may or may not be excluded\n\
2434 even if they match PATTERN and FACE.\n\
2435 The optional fourth argument MAXIMUM sets a limit on how many\n\
2436 fonts to match. The first MAXIMUM fonts are reported.\n\
2437 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2438 occupied by a character of a font. In that case, return only fonts\n\
2439 the WIDTH times as wide as FACE on FRAME.")
2440 (pattern
, face
, frame
, maximum
, width
)
2441 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2448 CHECK_STRING (pattern
, 0);
2454 CHECK_NATNUM (maximum
, 0);
2455 maxnames
= XINT (maximum
);
2459 CHECK_NUMBER (width
, 4);
2461 /* We can't simply call check_x_frame because this function may be
2462 called before any frame is created. */
2463 f
= frame_or_selected_frame (frame
, 2);
2466 /* Perhaps we have not yet created any frame. */
2471 /* Determine the width standard for comparison with the fonts we find. */
2477 /* This is of limited utility since it works with character
2478 widths. Keep it for compatibility. --gerd. */
2479 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2480 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2483 size
= face
->font
->max_bounds
.width
;
2485 size
= FRAME_FONT (f
)->max_bounds
.width
;
2488 size
*= XINT (width
);
2492 Lisp_Object args
[2];
2494 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2496 /* We don't have to check fontsets. */
2498 args
[1] = list_fontsets (f
, pattern
, size
);
2499 return Fnconc (2, args
);
2503 #endif /* HAVE_X_WINDOWS */
2507 /***********************************************************************
2509 ***********************************************************************/
2511 /* Access face attributes of face FACE, a Lisp vector. */
2513 #define LFACE_FAMILY(LFACE) \
2514 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2515 #define LFACE_HEIGHT(LFACE) \
2516 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2517 #define LFACE_WEIGHT(LFACE) \
2518 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2519 #define LFACE_SLANT(LFACE) \
2520 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2521 #define LFACE_UNDERLINE(LFACE) \
2522 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2523 #define LFACE_INVERSE(LFACE) \
2524 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2525 #define LFACE_FOREGROUND(LFACE) \
2526 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2527 #define LFACE_BACKGROUND(LFACE) \
2528 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2529 #define LFACE_STIPPLE(LFACE) \
2530 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2531 #define LFACE_SWIDTH(LFACE) \
2532 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2533 #define LFACE_OVERLINE(LFACE) \
2534 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2535 #define LFACE_STRIKE_THROUGH(LFACE) \
2536 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2537 #define LFACE_BOX(LFACE) \
2538 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2540 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2541 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2543 #define LFACEP(LFACE) \
2545 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2546 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2551 /* Check consistency of Lisp face attribute vector ATTRS. */
2554 check_lface_attrs (attrs
)
2557 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2558 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2559 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2560 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2561 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2562 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2563 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2564 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2565 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2566 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2567 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2568 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2569 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2570 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2571 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2572 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2573 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2574 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2575 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2576 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2577 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2578 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2579 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2580 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2581 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2582 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2583 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2584 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2585 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2586 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2587 #ifdef HAVE_WINDOW_SYSTEM
2588 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2589 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2590 || !NILP (Fpixmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2595 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2603 xassert (LFACEP (lface
));
2604 check_lface_attrs (XVECTOR (lface
)->contents
);
2608 #else /* GLYPH_DEBUG == 0 */
2610 #define check_lface_attrs(attrs) (void) 0
2611 #define check_lface(lface) (void) 0
2613 #endif /* GLYPH_DEBUG == 0 */
2616 /* Return the face definition of FACE_NAME on frame F. F null means
2617 return the global definition. FACE_NAME may be a string or a
2618 symbol (apparently Emacs 20.2 allows strings as face names in face
2619 text properties; ediff uses that). If FACE_NAME is an alias for
2620 another face, return that face's definition. If SIGNAL_P is
2621 non-zero, signal an error if FACE_NAME is not a valid face name.
2622 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2625 static INLINE Lisp_Object
2626 lface_from_face_name (f
, face_name
, signal_p
)
2628 Lisp_Object face_name
;
2631 Lisp_Object lface
, alias
;
2633 if (STRINGP (face_name
))
2634 face_name
= intern (XSTRING (face_name
)->data
);
2636 /* If FACE_NAME is an alias for another face, return the definition
2637 of the aliased face. */
2638 alias
= Fget (face_name
, Qface_alias
);
2643 lface
= assq_no_quit (face_name
, f
->face_alist
);
2645 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2648 lface
= XCDR (lface
);
2650 signal_error ("Invalid face", face_name
);
2652 check_lface (lface
);
2657 /* Get face attributes of face FACE_NAME from frame-local faces on
2658 frame F. Store the resulting attributes in ATTRS which must point
2659 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2660 is non-zero, signal an error if FACE_NAME does not name a face.
2661 Otherwise, value is zero if FACE_NAME is not a face. */
2664 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2666 Lisp_Object face_name
;
2673 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2676 bcopy (XVECTOR (lface
)->contents
, attrs
,
2677 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2687 /* Non-zero if all attributes in face attribute vector ATTRS are
2688 specified, i.e. are non-nil. */
2691 lface_fully_specified_p (attrs
)
2696 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2697 if (UNSPECIFIEDP (attrs
[i
]))
2700 return i
== LFACE_VECTOR_SIZE
;
2704 #ifdef HAVE_X_WINDOWS
2706 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2707 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2708 LFACE. Ignore fields of FONT_NAME containing wildcards. Value is
2709 zero if not successful because FONT_NAME was not in a valid format.
2710 A valid format is one that is suitable for split_font_name, see the
2714 set_lface_from_font_name (f
, lface
, font_name
, force_p
)
2720 struct font_name font
;
2723 int free_font_name_p
= 0;
2725 /* If FONT_NAME contains wildcards, use the first matching font. */
2726 if (index (font_name
, '*') || index (font_name
, '?'))
2728 if (!first_font_matching (f
, font_name
, &font
))
2730 free_font_name_p
= 1;
2734 font
.name
= STRDUPA (font_name
);
2735 if (!split_font_name (f
, &font
, 1))
2737 /* The font name may be something like `6x13'. Make
2738 sure we use the full name. */
2739 struct font_info
*font_info
;
2742 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2743 CHARSET_ASCII
, font_name
, -1);
2749 font
.name
= STRDUPA (font_info
->full_name
);
2750 split_font_name (f
, &font
, 1);
2753 /* FONT_NAME should not be a fontset name, here. */
2754 xassert (xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0);
2757 /* Set attributes only if unspecified, otherwise face defaults for
2758 new frames would never take effect. */
2760 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2762 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2763 + strlen (font
.fields
[XLFD_FOUNDRY
])
2765 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2766 font
.fields
[XLFD_FAMILY
]);
2767 LFACE_FAMILY (lface
) = build_string (buffer
);
2770 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2772 pt
= xlfd_point_size (f
, &font
);
2774 LFACE_HEIGHT (lface
) = make_number (pt
);
2777 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2778 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2780 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2781 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2783 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2784 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2786 if (free_font_name_p
)
2792 #endif /* HAVE_X_WINDOWS */
2795 /* Merge two Lisp face attribute vectors FROM and TO and store the
2796 resulting attributes in TO. Every non-nil attribute of FROM
2797 overrides the corresponding attribute of TO. */
2800 merge_face_vectors (from
, to
)
2801 Lisp_Object
*from
, *to
;
2804 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2805 if (!UNSPECIFIEDP (from
[i
]))
2810 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2811 is a face property, determine the resulting face attributes on
2812 frame F, and store them in TO. PROP may be a single face
2813 specification or a list of such specifications. Each face
2814 specification can be
2816 1. A symbol or string naming a Lisp face.
2818 2. A property list of the form (KEYWORD VALUE ...) where each
2819 KEYWORD is a face attribute name, and value is an appropriate value
2822 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2823 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2824 for compatibility with 20.2.
2826 Face specifications earlier in lists take precedence over later
2830 merge_face_vector_with_property (f
, to
, prop
)
2837 Lisp_Object first
= XCAR (prop
);
2839 if (EQ (first
, Qforeground_color
)
2840 || EQ (first
, Qbackground_color
))
2842 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2843 . COLOR). COLOR must be a string. */
2844 Lisp_Object color_name
= XCDR (prop
);
2845 Lisp_Object color
= first
;
2847 if (STRINGP (color_name
))
2849 if (EQ (color
, Qforeground_color
))
2850 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2852 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2855 add_to_log (f
, "Invalid face color", color_name
, Qnil
);
2857 else if (SYMBOLP (first
)
2858 && *XSYMBOL (first
)->name
->data
== ':')
2860 /* Assume this is the property list form. */
2861 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2863 Lisp_Object keyword
= XCAR (prop
);
2864 Lisp_Object value
= XCAR (XCDR (prop
));
2866 if (EQ (keyword
, QCfamily
))
2868 if (STRINGP (value
))
2869 to
[LFACE_FAMILY_INDEX
] = value
;
2871 add_to_log (f
, "Illegal face font family", value
, Qnil
);
2873 else if (EQ (keyword
, QCheight
))
2875 if (INTEGERP (value
))
2876 to
[LFACE_HEIGHT_INDEX
] = value
;
2878 add_to_log (f
, "Illegal face font height", value
, Qnil
);
2880 else if (EQ (keyword
, QCweight
))
2883 && face_numeric_weight (value
) >= 0)
2884 to
[LFACE_WEIGHT_INDEX
] = value
;
2886 add_to_log (f
, "Illegal face weight", value
, Qnil
);
2888 else if (EQ (keyword
, QCslant
))
2891 && face_numeric_slant (value
) >= 0)
2892 to
[LFACE_SLANT_INDEX
] = value
;
2894 add_to_log (f
, "Illegal face slant", value
, Qnil
);
2896 else if (EQ (keyword
, QCunderline
))
2901 to
[LFACE_UNDERLINE_INDEX
] = value
;
2903 add_to_log (f
, "Illegal face underline", value
, Qnil
);
2905 else if (EQ (keyword
, QCoverline
))
2910 to
[LFACE_OVERLINE_INDEX
] = value
;
2912 add_to_log (f
, "Illegal face overline", value
, Qnil
);
2914 else if (EQ (keyword
, QCstrike_through
))
2919 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2921 add_to_log (f
, "Illegal face strike-through", value
, Qnil
);
2923 else if (EQ (keyword
, QCbox
))
2926 value
= make_number (1);
2927 if (INTEGERP (value
)
2931 to
[LFACE_BOX_INDEX
] = value
;
2933 add_to_log (f
, "Illegal face box", value
, Qnil
);
2935 else if (EQ (keyword
, QCinverse_video
)
2936 || EQ (keyword
, QCreverse_video
))
2938 if (EQ (value
, Qt
) || NILP (value
))
2939 to
[LFACE_INVERSE_INDEX
] = value
;
2941 add_to_log (f
, "Illegal face inverse-video", value
, Qnil
);
2943 else if (EQ (keyword
, QCforeground
))
2945 if (STRINGP (value
))
2946 to
[LFACE_FOREGROUND_INDEX
] = value
;
2948 add_to_log (f
, "Illegal face foreground", value
, Qnil
);
2950 else if (EQ (keyword
, QCbackground
))
2952 if (STRINGP (value
))
2953 to
[LFACE_BACKGROUND_INDEX
] = value
;
2955 add_to_log (f
, "Illegal face background", value
, Qnil
);
2957 else if (EQ (keyword
, QCstipple
))
2959 #ifdef HAVE_X_WINDOWS
2960 Lisp_Object pixmap_p
= Fpixmap_spec_p (value
);
2961 if (!NILP (pixmap_p
))
2962 to
[LFACE_STIPPLE_INDEX
] = value
;
2964 add_to_log (f
, "Illegal face stipple", value
, Qnil
);
2967 else if (EQ (keyword
, QCwidth
))
2970 && face_numeric_swidth (value
) >= 0)
2971 to
[LFACE_SWIDTH_INDEX
] = value
;
2973 add_to_log (f
, "Illegal face width", value
, Qnil
);
2976 add_to_log (f
, "Invalid attribute %s in face property",
2979 prop
= XCDR (XCDR (prop
));
2984 /* This is a list of face specs. Specifications at the
2985 beginning of the list take precedence over later
2986 specifications, so we have to merge starting with the
2987 last specification. */
2988 Lisp_Object next
= XCDR (prop
);
2990 merge_face_vector_with_property (f
, to
, next
);
2991 merge_face_vector_with_property (f
, to
, first
);
2996 /* PROP ought to be a face name. */
2997 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
2999 add_to_log (f
, "Invalid face text property value: %s", prop
, Qnil
);
3001 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3006 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3007 Sinternal_make_lisp_face
, 1, 2, 0,
3008 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3009 If FACE was not known as a face before, create a new one.\n\
3010 If optional argument FRAME is specified, make a frame-local face\n\
3011 for that frame. Otherwise operate on the global face definition.\n\
3012 Value is a vector of face attributes.")
3014 Lisp_Object face
, frame
;
3016 Lisp_Object global_lface
, lface
;
3020 CHECK_SYMBOL (face
, 0);
3021 global_lface
= lface_from_face_name (NULL
, face
, 0);
3025 CHECK_LIVE_FRAME (frame
, 1);
3027 lface
= lface_from_face_name (f
, face
, 0);
3030 f
= NULL
, lface
= Qnil
;
3032 /* Add a global definition if there is none. */
3033 if (NILP (global_lface
))
3035 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3037 XVECTOR (global_lface
)->contents
[0] = Qface
;
3038 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3039 Vface_new_frame_defaults
);
3041 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3042 face id to Lisp face is given by the vector lface_id_to_name.
3043 The mapping from Lisp face to Lisp face id is given by the
3044 property `face' of the Lisp face name. */
3045 if (next_lface_id
== lface_id_to_name_size
)
3047 int new_size
= max (50, 2 * lface_id_to_name_size
);
3048 int sz
= new_size
* sizeof *lface_id_to_name
;
3049 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3050 lface_id_to_name_size
= new_size
;
3053 lface_id_to_name
[next_lface_id
] = face
;
3054 Fput (face
, Qface
, make_number (next_lface_id
));
3058 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3059 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3061 /* Add a frame-local definition. */
3066 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3068 XVECTOR (lface
)->contents
[0] = Qface
;
3069 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3072 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3073 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3076 lface
= global_lface
;
3078 xassert (LFACEP (lface
));
3079 check_lface (lface
);
3084 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3085 Sinternal_lisp_face_p
, 1, 2, 0,
3086 "Return non-nil if FACE names a face.\n\
3087 If optional second parameter FRAME is non-nil, check for the\n\
3088 existence of a frame-local face with name FACE on that frame.\n\
3089 Otherwise check for the existence of a global face.")
3091 Lisp_Object face
, frame
;
3097 CHECK_LIVE_FRAME (frame
, 1);
3098 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3101 lface
= lface_from_face_name (NULL
, face
, 0);
3107 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3108 Sinternal_copy_lisp_face
, 4, 4, 0,
3109 "Copy face FROM to TO.\n\
3110 If FRAME it t, copy the global face definition of FROM to the\n\
3111 global face definition of TO. Otherwise, copy the frame-local\n\
3112 definition of FROM on FRAME to the frame-local definition of TO\n\
3113 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3116 (from
, to
, frame
, new_frame
)
3117 Lisp_Object from
, to
, frame
, new_frame
;
3119 Lisp_Object lface
, copy
;
3121 CHECK_SYMBOL (from
, 0);
3122 CHECK_SYMBOL (to
, 1);
3123 if (NILP (new_frame
))
3128 /* Copy global definition of FROM. We don't make copies of
3129 strings etc. because 20.2 didn't do it either. */
3130 lface
= lface_from_face_name (NULL
, from
, 1);
3131 copy
= Finternal_make_lisp_face (to
, Qnil
);
3135 /* Copy frame-local definition of FROM. */
3136 CHECK_LIVE_FRAME (frame
, 2);
3137 CHECK_LIVE_FRAME (new_frame
, 3);
3138 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3139 copy
= Finternal_make_lisp_face (to
, new_frame
);
3142 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3143 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3149 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3150 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3151 "Set attribute ATTR of FACE to VALUE.\n\
3152 If optional argument FRAME is given, set the face attribute of face FACE\n\
3153 on that frame. If FRAME is t, set the attribute of the default for face\n\
3154 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3156 (face
, attr
, value
, frame
)
3157 Lisp_Object face
, attr
, value
, frame
;
3160 Lisp_Object old_value
= Qnil
;
3161 int font_related_attr_p
= 0;
3163 CHECK_SYMBOL (face
, 0);
3164 CHECK_SYMBOL (attr
, 1);
3166 /* Set lface to the Lisp attribute vector of FACE. */
3168 lface
= lface_from_face_name (NULL
, face
, 1);
3172 frame
= selected_frame
;
3174 CHECK_LIVE_FRAME (frame
, 3);
3175 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3177 /* If a frame-local face doesn't exist yet, create one. */
3179 lface
= Finternal_make_lisp_face (face
, frame
);
3182 if (EQ (attr
, QCfamily
))
3184 if (!UNSPECIFIEDP (value
))
3186 CHECK_STRING (value
, 3);
3187 if (XSTRING (value
)->size
== 0)
3188 signal_error ("Invalid face family", value
);
3190 old_value
= LFACE_FAMILY (lface
);
3191 LFACE_FAMILY (lface
) = value
;
3192 font_related_attr_p
= 1;
3194 else if (EQ (attr
, QCheight
))
3196 if (!UNSPECIFIEDP (value
))
3198 CHECK_NUMBER (value
, 3);
3199 if (XINT (value
) <= 0)
3200 signal_error ("Invalid face height", value
);
3202 old_value
= LFACE_HEIGHT (lface
);
3203 LFACE_HEIGHT (lface
) = value
;
3204 font_related_attr_p
= 1;
3206 else if (EQ (attr
, QCweight
))
3208 if (!UNSPECIFIEDP (value
))
3210 CHECK_SYMBOL (value
, 3);
3211 if (face_numeric_weight (value
) < 0)
3212 signal_error ("Invalid face weight", value
);
3214 old_value
= LFACE_WEIGHT (lface
);
3215 LFACE_WEIGHT (lface
) = value
;
3216 font_related_attr_p
= 1;
3218 else if (EQ (attr
, QCslant
))
3220 if (!UNSPECIFIEDP (value
))
3222 CHECK_SYMBOL (value
, 3);
3223 if (face_numeric_slant (value
) < 0)
3224 signal_error ("Invalid face slant", value
);
3226 old_value
= LFACE_SLANT (lface
);
3227 LFACE_SLANT (lface
) = value
;
3228 font_related_attr_p
= 1;
3230 else if (EQ (attr
, QCunderline
))
3232 if (!UNSPECIFIEDP (value
))
3233 if ((SYMBOLP (value
)
3235 && !EQ (value
, Qnil
))
3236 /* Underline color. */
3238 && XSTRING (value
)->size
== 0))
3239 signal_error ("Invalid face underline", value
);
3241 old_value
= LFACE_UNDERLINE (lface
);
3242 LFACE_UNDERLINE (lface
) = value
;
3244 else if (EQ (attr
, QCoverline
))
3246 if (!UNSPECIFIEDP (value
))
3247 if ((SYMBOLP (value
)
3249 && !EQ (value
, Qnil
))
3250 /* Overline color. */
3252 && XSTRING (value
)->size
== 0))
3253 signal_error ("Invalid face overline", value
);
3255 old_value
= LFACE_OVERLINE (lface
);
3256 LFACE_OVERLINE (lface
) = value
;
3258 else if (EQ (attr
, QCstrike_through
))
3260 if (!UNSPECIFIEDP (value
))
3261 if ((SYMBOLP (value
)
3263 && !EQ (value
, Qnil
))
3264 /* Strike-through color. */
3266 && XSTRING (value
)->size
== 0))
3267 signal_error ("Invalid face strike-through", value
);
3269 old_value
= LFACE_STRIKE_THROUGH (lface
);
3270 LFACE_STRIKE_THROUGH (lface
) = value
;
3272 else if (EQ (attr
, QCbox
))
3276 /* Allow t meaning a simple box of width 1 in foreground color
3279 value
= make_number (1);
3281 if (UNSPECIFIEDP (value
))
3283 else if (NILP (value
))
3285 else if (INTEGERP (value
))
3286 valid_p
= XINT (value
) > 0;
3287 else if (STRINGP (value
))
3288 valid_p
= XSTRING (value
)->size
> 0;
3289 else if (CONSP (value
))
3305 if (EQ (k
, QCline_width
))
3307 if (!INTEGERP (v
) || XINT (v
) <= 0)
3310 else if (EQ (k
, QCcolor
))
3312 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3315 else if (EQ (k
, QCstyle
))
3317 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3324 valid_p
= NILP (tem
);
3330 signal_error ("Invalid face box", value
);
3332 old_value
= LFACE_BOX (lface
);
3333 LFACE_BOX (lface
) = value
;
3335 else if (EQ (attr
, QCinverse_video
)
3336 || EQ (attr
, QCreverse_video
))
3338 if (!UNSPECIFIEDP (value
))
3340 CHECK_SYMBOL (value
, 3);
3341 if (!EQ (value
, Qt
) && !NILP (value
))
3342 signal_error ("Invalid inverse-video face attribute value", value
);
3344 old_value
= LFACE_INVERSE (lface
);
3345 LFACE_INVERSE (lface
) = value
;
3347 else if (EQ (attr
, QCforeground
))
3349 if (!UNSPECIFIEDP (value
))
3351 /* Don't check for valid color names here because it depends
3352 on the frame (display) whether the color will be valid
3353 when the face is realized. */
3354 CHECK_STRING (value
, 3);
3355 if (XSTRING (value
)->size
== 0)
3356 signal_error ("Empty foreground color value", value
);
3358 old_value
= LFACE_FOREGROUND (lface
);
3359 LFACE_FOREGROUND (lface
) = value
;
3361 else if (EQ (attr
, QCbackground
))
3363 if (!UNSPECIFIEDP (value
))
3365 /* Don't check for valid color names here because it depends
3366 on the frame (display) whether the color will be valid
3367 when the face is realized. */
3368 CHECK_STRING (value
, 3);
3369 if (XSTRING (value
)->size
== 0)
3370 signal_error ("Empty background color value", value
);
3372 old_value
= LFACE_BACKGROUND (lface
);
3373 LFACE_BACKGROUND (lface
) = value
;
3375 else if (EQ (attr
, QCstipple
))
3377 #ifdef HAVE_X_WINDOWS
3378 if (!UNSPECIFIEDP (value
)
3380 && NILP (Fpixmap_spec_p (value
)))
3381 signal_error ("Invalid stipple attribute", value
);
3382 old_value
= LFACE_STIPPLE (lface
);
3383 LFACE_STIPPLE (lface
) = value
;
3384 #endif /* HAVE_X_WINDOWS */
3386 else if (EQ (attr
, QCwidth
))
3388 if (!UNSPECIFIEDP (value
))
3390 CHECK_SYMBOL (value
, 3);
3391 if (face_numeric_swidth (value
) < 0)
3392 signal_error ("Invalid face width", value
);
3394 old_value
= LFACE_SWIDTH (lface
);
3395 LFACE_SWIDTH (lface
) = value
;
3396 font_related_attr_p
= 1;
3398 else if (EQ (attr
, QCfont
))
3400 #ifdef HAVE_X_WINDOWS
3401 /* Set font-related attributes of the Lisp face from an
3405 CHECK_STRING (value
, 3);
3407 f
= SELECTED_FRAME ();
3409 f
= check_x_frame (frame
);
3411 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1))
3412 signal_error ("Invalid font name", value
);
3414 font_related_attr_p
= 1;
3415 #endif /* HAVE_X_WINDOWS */
3417 else if (EQ (attr
, QCbold
))
3419 old_value
= LFACE_WEIGHT (lface
);
3420 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3421 font_related_attr_p
= 1;
3423 else if (EQ (attr
, QCitalic
))
3425 old_value
= LFACE_SLANT (lface
);
3426 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3427 font_related_attr_p
= 1;
3430 signal_error ("Invalid face attribute name", attr
);
3432 /* Changing a named face means that all realized faces depending on
3433 that face are invalid. Since we cannot tell which realized faces
3434 depend on the face, make sure they are all removed. This is done
3435 by incrementing face_change_count. The next call to
3436 init_iterator will then free realized faces. */
3438 && (EQ (attr
, QCfont
)
3439 || NILP (Fequal (old_value
, value
))))
3441 ++face_change_count
;
3442 ++windows_or_buffers_changed
;
3445 #ifdef HAVE_X_WINDOWS
3448 && !UNSPECIFIEDP (value
)
3449 && NILP (Fequal (old_value
, value
)))
3455 if (EQ (face
, Qdefault
))
3457 /* Changed font-related attributes of the `default' face are
3458 reflected in changed `font' frame parameters. */
3459 if (font_related_attr_p
3460 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3461 set_font_frame_param (frame
, lface
);
3462 else if (EQ (attr
, QCforeground
))
3463 param
= Qforeground_color
;
3464 else if (EQ (attr
, QCbackground
))
3465 param
= Qbackground_color
;
3467 else if (EQ (face
, Qscroll_bar
))
3469 /* Changing the colors of `scroll-bar' sets frame parameters
3470 `scroll-bar-foreground' and `scroll-bar-background'. */
3471 if (EQ (attr
, QCforeground
))
3472 param
= Qscroll_bar_foreground
;
3473 else if (EQ (attr
, QCbackground
))
3474 param
= Qscroll_bar_background
;
3476 else if (EQ (face
, Qborder
))
3478 /* Changing background color of `border' sets frame parameter
3480 if (EQ (attr
, QCbackground
))
3481 param
= Qborder_color
;
3483 else if (EQ (face
, Qcursor
))
3485 /* Changing background color of `cursor' sets frame parameter
3487 if (EQ (attr
, QCbackground
))
3488 param
= Qcursor_color
;
3490 else if (EQ (face
, Qmouse
))
3492 /* Changing background color of `mouse' sets frame parameter
3494 if (EQ (attr
, QCbackground
))
3495 param
= Qmouse_color
;
3498 if (SYMBOLP (param
))
3499 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3502 #endif /* HAVE_X_WINDOWS */
3508 #ifdef HAVE_X_WINDOWS
3510 /* Set the `font' frame parameter of FRAME according to `default' face
3511 attributes LFACE. */
3514 set_font_frame_param (frame
, lface
)
3515 Lisp_Object frame
, lface
;
3517 struct frame
*f
= XFRAME (frame
);
3518 Lisp_Object frame_font
;
3522 /* Get FRAME's font parameter. */
3523 frame_font
= Fassq (Qfont
, f
->param_alist
);
3524 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3525 frame_font
= XCDR (frame_font
);
3527 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3530 /* Frame parameter is a fontset name. Modify the fontset so
3531 that all its fonts reflect face attributes LFACE. */
3533 struct fontset_info
*fontset_info
;
3535 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3537 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3538 if (fontset_info
->fontname
[charset
])
3540 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3542 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3543 build_string (font
), frame
);
3549 /* Frame parameter is an X font name. I believe this can
3550 only happen in unibyte mode. */
3551 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3552 -1, Vface_default_registry
);
3555 store_frame_param (f
, Qfont
, build_string (font
));
3562 /* Update the corresponding face when frame parameter PARAM on frame F
3563 has been assigned the value NEW_VALUE. */
3566 update_face_from_frame_parameter (f
, param
, new_value
)
3568 Lisp_Object param
, new_value
;
3572 /* If there are no faces yet, give up. This is the case when called
3573 from Fx_create_frame, and we do the necessary things later in
3574 face-set-after-frame-defaults. */
3575 if (NILP (f
->face_alist
))
3578 if (EQ (param
, Qforeground_color
))
3580 lface
= lface_from_face_name (f
, Qdefault
, 1);
3581 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3582 ? new_value
: Qunspecified
);
3583 realize_basic_faces (f
);
3585 else if (EQ (param
, Qbackground_color
))
3589 /* Changing the background color might change the background
3590 mode, so that we have to load new defface specs. Call
3591 frame-update-face-colors to do that. */
3592 XSETFRAME (frame
, f
);
3593 call1 (Qframe_update_face_colors
, frame
);
3595 lface
= lface_from_face_name (f
, Qdefault
, 1);
3596 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3597 ? new_value
: Qunspecified
);
3598 realize_basic_faces (f
);
3600 if (EQ (param
, Qborder_color
))
3602 lface
= lface_from_face_name (f
, Qborder
, 1);
3603 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3604 ? new_value
: Qunspecified
);
3606 else if (EQ (param
, Qcursor_color
))
3608 lface
= lface_from_face_name (f
, Qcursor
, 1);
3609 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3610 ? new_value
: Qunspecified
);
3612 else if (EQ (param
, Qmouse_color
))
3614 lface
= lface_from_face_name (f
, Qmouse
, 1);
3615 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3616 ? new_value
: Qunspecified
);
3621 /* Get the value of X resource RESOURCE, class CLASS for the display
3622 of frame FRAME. This is here because ordinary `x-get-resource'
3623 doesn't take a frame argument. */
3625 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3626 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3627 (resource
, class, frame
)
3628 Lisp_Object resource
, class, frame
;
3631 CHECK_STRING (resource
, 0);
3632 CHECK_STRING (class, 1);
3633 CHECK_LIVE_FRAME (frame
, 2);
3635 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3636 resource
, class, Qnil
, Qnil
);
3642 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3643 If VALUE is "on" or "true", return t. If VALUE is "off" or
3644 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3645 error; if SIGNAL_P is zero, return 0. */
3648 face_boolean_x_resource_value (value
, signal_p
)
3652 Lisp_Object result
= make_number (0);
3654 xassert (STRINGP (value
));
3656 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3657 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3659 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3660 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3662 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3663 result
= Qunspecified
;
3665 signal_error ("Invalid face attribute value from X resource", value
);
3671 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3672 Finternal_set_lisp_face_attribute_from_resource
,
3673 Sinternal_set_lisp_face_attribute_from_resource
,
3675 (face
, attr
, value
, frame
)
3676 Lisp_Object face
, attr
, value
, frame
;
3678 CHECK_SYMBOL (face
, 0);
3679 CHECK_SYMBOL (attr
, 1);
3680 CHECK_STRING (value
, 2);
3682 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3683 value
= Qunspecified
;
3684 else if (EQ (attr
, QCheight
))
3686 value
= Fstring_to_number (value
, make_number (10));
3687 if (XINT (value
) <= 0)
3688 signal_error ("Invalid face height from X resource", value
);
3690 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3691 value
= face_boolean_x_resource_value (value
, 1);
3692 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3693 value
= intern (XSTRING (value
)->data
);
3694 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3695 value
= face_boolean_x_resource_value (value
, 1);
3696 else if (EQ (attr
, QCunderline
)
3697 || EQ (attr
, QCoverline
)
3698 || EQ (attr
, QCstrike_through
)
3699 || EQ (attr
, QCbox
))
3701 Lisp_Object boolean_value
;
3703 /* If the result of face_boolean_x_resource_value is t or nil,
3704 VALUE does NOT specify a color. */
3705 boolean_value
= face_boolean_x_resource_value (value
, 0);
3706 if (SYMBOLP (boolean_value
))
3707 value
= boolean_value
;
3710 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3714 #endif /* HAVE_X_WINDOWS */
3718 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3719 Sinternal_get_lisp_face_attribute
,
3721 "Return face attribute KEYWORD of face SYMBOL.\n\
3722 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
3723 face attribute name, signal an error.\n\
3724 If the optional argument FRAME is given, report on face FACE in that\n\
3725 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
3726 frames). If FRAME is omitted or nil, use the selected frame.")
3727 (symbol
, keyword
, frame
)
3728 Lisp_Object symbol
, keyword
, frame
;
3730 Lisp_Object lface
, value
= Qnil
;
3732 CHECK_SYMBOL (symbol
, 0);
3733 CHECK_SYMBOL (keyword
, 1);
3736 lface
= lface_from_face_name (NULL
, symbol
, 1);
3740 frame
= selected_frame
;
3741 CHECK_LIVE_FRAME (frame
, 2);
3742 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3745 if (EQ (keyword
, QCfamily
))
3746 value
= LFACE_FAMILY (lface
);
3747 else if (EQ (keyword
, QCheight
))
3748 value
= LFACE_HEIGHT (lface
);
3749 else if (EQ (keyword
, QCweight
))
3750 value
= LFACE_WEIGHT (lface
);
3751 else if (EQ (keyword
, QCslant
))
3752 value
= LFACE_SLANT (lface
);
3753 else if (EQ (keyword
, QCunderline
))
3754 value
= LFACE_UNDERLINE (lface
);
3755 else if (EQ (keyword
, QCoverline
))
3756 value
= LFACE_OVERLINE (lface
);
3757 else if (EQ (keyword
, QCstrike_through
))
3758 value
= LFACE_STRIKE_THROUGH (lface
);
3759 else if (EQ (keyword
, QCbox
))
3760 value
= LFACE_BOX (lface
);
3761 else if (EQ (keyword
, QCinverse_video
)
3762 || EQ (keyword
, QCreverse_video
))
3763 value
= LFACE_INVERSE (lface
);
3764 else if (EQ (keyword
, QCforeground
))
3765 value
= LFACE_FOREGROUND (lface
);
3766 else if (EQ (keyword
, QCbackground
))
3767 value
= LFACE_BACKGROUND (lface
);
3768 else if (EQ (keyword
, QCstipple
))
3769 value
= LFACE_STIPPLE (lface
);
3770 else if (EQ (keyword
, QCwidth
))
3771 value
= LFACE_SWIDTH (lface
);
3773 signal_error ("Invalid face attribute name", keyword
);
3779 DEFUN ("internal-lisp-face-attribute-values",
3780 Finternal_lisp_face_attribute_values
,
3781 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3782 "Return a list of valid discrete values for face attribute ATTR.\n\
3783 Value is nil if ATTR doesn't have a discrete set of valid values.")
3787 Lisp_Object result
= Qnil
;
3789 CHECK_SYMBOL (attr
, 0);
3791 if (EQ (attr
, QCweight
)
3792 || EQ (attr
, QCslant
)
3793 || EQ (attr
, QCwidth
))
3795 /* Extract permissible symbols from tables. */
3796 struct table_entry
*table
;
3799 if (EQ (attr
, QCweight
))
3800 table
= weight_table
, dim
= DIM (weight_table
);
3801 else if (EQ (attr
, QCslant
))
3802 table
= slant_table
, dim
= DIM (slant_table
);
3804 table
= swidth_table
, dim
= DIM (swidth_table
);
3806 for (i
= 0; i
< dim
; ++i
)
3808 Lisp_Object symbol
= *table
[i
].symbol
;
3809 Lisp_Object tail
= result
;
3812 && !EQ (XCAR (tail
), symbol
))
3816 result
= Fcons (symbol
, result
);
3819 else if (EQ (attr
, QCunderline
))
3820 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3821 else if (EQ (attr
, QCoverline
))
3822 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3823 else if (EQ (attr
, QCstrike_through
))
3824 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3825 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3826 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3832 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3833 Sinternal_merge_in_global_face
, 2, 2, 0,
3834 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
3836 Lisp_Object face
, frame
;
3838 Lisp_Object global_lface
, local_lface
;
3839 CHECK_LIVE_FRAME (frame
, 1);
3840 global_lface
= lface_from_face_name (NULL
, face
, 1);
3841 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3842 if (NILP (local_lface
))
3843 local_lface
= Finternal_make_lisp_face (face
, frame
);
3844 merge_face_vectors (XVECTOR (global_lface
)->contents
,
3845 XVECTOR (local_lface
)->contents
);
3850 /* The following function is implemented for compatibility with 20.2.
3851 The function is used in x-resolve-fonts when it is asked to
3852 return fonts with the same size as the font of a face. This is
3853 done in fontset.el. */
3855 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
3856 "Return the font name of face FACE, or nil if it is unspecified.\n\
3857 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3858 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3859 The font default for a face is either nil, or a list\n\
3860 of the form (bold), (italic) or (bold italic).\n\
3861 If FRAME is omitted or nil, use the selected frame.")
3863 Lisp_Object face
, frame
;
3867 Lisp_Object result
= Qnil
;
3868 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3870 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3871 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3872 result
= Fcons (Qbold
, result
);
3874 if (!NILP (LFACE_SLANT (lface
))
3875 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3876 result
= Fcons (Qitalic
, result
);
3882 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3883 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
3884 struct face
*face
= FACE_FROM_ID (f
, face_id
);
3885 return build_string (face
->font_name
);
3890 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3891 all attributes are `equal'. Tries to be fast because this function
3892 is called quite often. */
3895 lface_equal_p (v1
, v2
)
3896 Lisp_Object
*v1
, *v2
;
3900 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3902 Lisp_Object a
= v1
[i
];
3903 Lisp_Object b
= v2
[i
];
3905 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3906 and the other is specified. */
3907 equal_p
= XTYPE (a
) == XTYPE (b
);
3916 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
3917 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
3918 XSTRING (a
)->size
) == 0);
3927 equal_p
= !NILP (Fequal (a
, b
));
3937 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3938 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3939 "True if FACE1 and FACE2 are equal.\n\
3940 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3941 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3942 If FRAME is omitted or nil, use the selected frame.")
3943 (face1
, face2
, frame
)
3944 Lisp_Object face1
, face2
, frame
;
3948 Lisp_Object lface1
, lface2
;
3953 /* Don't use check_x_frame here because this function is called
3954 before X frames exist. At that time, if FRAME is nil,
3955 selected_frame will be used which is the frame dumped with
3956 Emacs. That frame is not an X frame. */
3957 f
= frame_or_selected_frame (frame
, 2);
3959 lface1
= lface_from_face_name (NULL
, face1
, 1);
3960 lface2
= lface_from_face_name (NULL
, face2
, 1);
3961 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
3962 XVECTOR (lface2
)->contents
);
3963 return equal_p
? Qt
: Qnil
;
3967 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3968 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3969 "True if FACE has no attribute specified.\n\
3970 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3971 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3972 If FRAME is omitted or nil, use the selected frame.")
3974 Lisp_Object face
, frame
;
3981 frame
= selected_frame
;
3982 CHECK_LIVE_FRAME (frame
, 0);
3986 lface
= lface_from_face_name (NULL
, face
, 1);
3988 lface
= lface_from_face_name (f
, face
, 1);
3990 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3991 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
3994 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
3998 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4000 "Return an alist of frame-local faces defined on FRAME.\n\
4001 For internal use only.")
4005 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4006 return f
->face_alist
;
4010 /* Return a hash code for Lisp string STRING with case ignored. Used
4011 below in computing a hash value for a Lisp face. */
4013 static INLINE
unsigned
4014 hash_string_case_insensitive (string
)
4019 xassert (STRINGP (string
));
4020 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4021 hash
= (hash
<< 1) ^ tolower (*s
);
4026 /* Return a hash code for face attribute vector V. */
4028 static INLINE
unsigned
4032 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4033 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4034 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4035 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4036 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4037 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4038 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4042 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4043 considering charsets/registries). They do if they specify the same
4044 family, point size, weight, width and slant. Both LFACE1 and
4045 LFACE2 must be fully-specified. */
4048 lface_same_font_attributes_p (lface1
, lface2
)
4049 Lisp_Object
*lface1
, *lface2
;
4051 xassert (lface_fully_specified_p (lface1
)
4052 && lface_fully_specified_p (lface2
));
4053 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4054 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4055 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4056 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4057 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4058 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4059 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4064 /***********************************************************************
4066 ***********************************************************************/
4068 /* Allocate and return a new realized face for Lisp face attribute
4069 vector ATTR, charset CHARSET, and registry REGISTRY. */
4071 static struct face
*
4072 make_realized_face (attr
, charset
, registry
)
4075 Lisp_Object registry
;
4077 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4078 bzero (face
, sizeof *face
);
4079 face
->charset
= charset
;
4080 face
->registry
= registry
;
4081 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4086 /* Free realized face FACE, including its X resources. FACE may
4090 free_realized_face (f
, face
)
4096 #ifdef HAVE_X_WINDOWS
4101 x_free_gc (f
, face
->gc
);
4105 free_face_colors (f
, face
);
4106 x_destroy_bitmap (f
, face
->stipple
);
4108 #endif /* HAVE_X_WINDOWS */
4115 /* Prepare face FACE for subsequent display on frame F. This
4116 allocated GCs if they haven't been allocated yet or have been freed
4117 by clearing the face cache. */
4120 prepare_face_for_display (f
, face
)
4124 #ifdef HAVE_X_WINDOWS
4125 xassert (FRAME_X_P (f
));
4130 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4132 xgcv
.foreground
= face
->foreground
;
4133 xgcv
.background
= face
->background
;
4134 xgcv
.graphics_exposures
= False
;
4136 /* The font of FACE may be null if we couldn't load it. */
4139 xgcv
.font
= face
->font
->fid
;
4146 xgcv
.fill_style
= FillOpaqueStippled
;
4147 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4148 mask
|= GCFillStyle
| GCStipple
;
4151 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4158 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4159 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4160 ISO8859-1 if the ASCII face suffices. */
4163 face_suitable_for_iso8859_1_p (face
)
4166 int len
= strlen (face
->font_name
);
4167 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4171 /* Value is non-zero if FACE is suitable for displaying characters
4172 of CHARSET. CHARSET < 0 means unibyte text. */
4175 face_suitable_for_charset_p (face
, charset
)
4183 if (EQ (face
->registry
, Vface_default_registry
)
4184 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4187 else if (face
->charset
== charset
)
4189 else if (face
->charset
== CHARSET_ASCII
4190 && charset
== charset_latin_iso8859_1
)
4191 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4192 else if (face
->charset
== charset_latin_iso8859_1
4193 && charset
== CHARSET_ASCII
)
4201 /***********************************************************************
4203 ***********************************************************************/
4205 /* Return a new face cache for frame F. */
4207 static struct face_cache
*
4211 struct face_cache
*c
;
4214 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4215 bzero (c
, sizeof *c
);
4216 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4217 c
->buckets
= (struct face
**) xmalloc (size
);
4218 bzero (c
->buckets
, size
);
4220 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4226 /* Clear out all graphics contexts for all realized faces, except for
4227 the basic faces. This should be done from time to time just to avoid
4228 keeping too many graphics contexts that are no longer needed. */
4232 struct face_cache
*c
;
4234 if (c
&& FRAME_X_P (c
->f
))
4236 #ifdef HAVE_X_WINDOWS
4238 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4240 struct face
*face
= c
->faces_by_id
[i
];
4241 if (face
&& face
->gc
)
4243 x_free_gc (c
->f
, face
->gc
);
4247 #endif /* HAVE_X_WINDOWS */
4252 /* Free all realized faces in face cache C, including basic faces. C
4253 may be null. If faces are freed, make sure the frame's current
4254 matrix is marked invalid, so that a display caused by an expose
4255 event doesn't try to use faces we destroyed. */
4258 free_realized_faces (c
)
4259 struct face_cache
*c
;
4264 struct frame
*f
= c
->f
;
4266 for (i
= 0; i
< c
->used
; ++i
)
4268 free_realized_face (f
, c
->faces_by_id
[i
]);
4269 c
->faces_by_id
[i
] = NULL
;
4273 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4274 bzero (c
->buckets
, size
);
4276 /* Must do a thorough redisplay the next time. Mark current
4277 matrices as invalid because they will reference faces freed
4278 above. This function is also called when a frame is
4279 destroyed. In this case, the root window of F is nil. */
4280 if (WINDOWP (f
->root_window
))
4282 clear_current_matrices (f
);
4283 ++windows_or_buffers_changed
;
4289 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4290 This is done after attributes of a named face have been changed,
4291 because we can't tell which realized faces depend on that face. */
4294 free_all_realized_faces (frame
)
4300 FOR_EACH_FRAME (rest
, frame
)
4301 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4304 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4308 /* Free face cache C and faces in it, including their X resources. */
4312 struct face_cache
*c
;
4316 free_realized_faces (c
);
4318 xfree (c
->faces_by_id
);
4324 /* Cache realized face FACE in face cache C. HASH is the hash value
4325 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4326 collision list of the face hash table of C. This is done because
4327 otherwise lookup_face would find FACE for every charset, even if
4328 faces with the same attributes but for specific charsets exist. */
4331 cache_face (c
, face
, hash
)
4332 struct face_cache
*c
;
4336 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4340 if (face
->fontset
>= 0)
4342 struct face
*last
= c
->buckets
[i
];
4353 c
->buckets
[i
] = face
;
4354 face
->prev
= face
->next
= NULL
;
4360 face
->next
= c
->buckets
[i
];
4362 face
->next
->prev
= face
;
4363 c
->buckets
[i
] = face
;
4366 /* Find a free slot in C->faces_by_id and use the index of the free
4367 slot as FACE->id. */
4368 for (i
= 0; i
< c
->used
; ++i
)
4369 if (c
->faces_by_id
[i
] == NULL
)
4373 /* Maybe enlarge C->faces_by_id. */
4374 if (i
== c
->used
&& c
->used
== c
->size
)
4376 int new_size
= 2 * c
->size
;
4377 int sz
= new_size
* sizeof *c
->faces_by_id
;
4378 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4383 /* Check that FACE got a unique id. */
4388 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4389 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4395 #endif /* GLYPH_DEBUG */
4397 c
->faces_by_id
[i
] = face
;
4403 /* Remove face FACE from cache C. */
4406 uncache_face (c
, face
)
4407 struct face_cache
*c
;
4410 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4413 face
->prev
->next
= face
->next
;
4415 c
->buckets
[i
] = face
->next
;
4418 face
->next
->prev
= face
->prev
;
4420 c
->faces_by_id
[face
->id
] = NULL
;
4421 if (face
->id
== c
->used
)
4426 /* Look up a realized face with face attributes ATTR in the face cache
4427 of frame F. The face will be used to display characters of
4428 CHARSET. CHARSET < 0 means the face will be used to display
4429 unibyte text. The value of face-default-registry is used to choose
4430 a font for the face in that case. Value is the ID of the face
4431 found. If no suitable face is found, realize a new one. */
4434 lookup_face (f
, attr
, charset
)
4439 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4444 xassert (c
!= NULL
);
4445 check_lface_attrs (attr
);
4447 /* Look up ATTR in the face cache. */
4448 hash
= lface_hash (attr
);
4449 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4451 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4452 if (face
->hash
== hash
4453 && (!FRAME_WINDOW_P (f
)
4454 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4455 && lface_equal_p (face
->lface
, attr
))
4458 /* If not found, realize a new face. */
4461 face
= realize_face (c
, attr
, charset
);
4462 cache_face (c
, face
, hash
);
4466 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4468 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4469 #endif /* GLYPH_DEBUG */
4475 /* Return the face id of the realized face for named face SYMBOL on
4476 frame F suitable for displaying characters from CHARSET. CHARSET <
4477 0 means unibyte text. */
4480 lookup_named_face (f
, symbol
, charset
)
4485 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4486 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4487 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4489 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4490 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4491 merge_face_vectors (symbol_attrs
, attrs
);
4492 return lookup_face (f
, attrs
, charset
);
4496 /* Return the ID of the realized ASCII face of Lisp face with ID
4497 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4500 ascii_face_of_lisp_face (f
, lface_id
)
4506 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4508 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4509 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4518 /* Return a face for charset ASCII that is like the face with id
4519 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4520 STEPS < 0 means larger. Value is the id of the face. */
4523 smaller_face (f
, face_id
, steps
)
4527 #ifdef HAVE_X_WINDOWS
4529 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4530 int pt
, last_pt
, last_height
;
4533 struct face
*new_face
;
4535 /* If not called for an X frame, just return the original face. */
4536 if (FRAME_TERMCAP_P (f
))
4539 /* Try in increments of 1/2 pt. */
4540 delta
= steps
< 0 ? 5 : -5;
4541 steps
= abs (steps
);
4543 face
= FACE_FROM_ID (f
, face_id
);
4544 bcopy (face
->lface
, attrs
, sizeof attrs
);
4545 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4546 new_face_id
= face_id
;
4547 last_height
= FONT_HEIGHT (face
->font
);
4551 /* Give up if we cannot find a font within 10pt. */
4552 && abs (last_pt
- pt
) < 100)
4554 /* Look up a face for a slightly smaller/larger font. */
4556 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4557 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4558 new_face
= FACE_FROM_ID (f
, new_face_id
);
4560 /* If height changes, count that as one step. */
4561 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4564 last_height
= FONT_HEIGHT (new_face
->font
);
4571 #else /* not HAVE_X_WINDOWS */
4575 #endif /* not HAVE_X_WINDOWS */
4579 /* Return a face for charset ASCII that is like the face with id
4580 FACE_ID on frame F, but has height HEIGHT. */
4583 face_with_height (f
, face_id
, height
)
4588 #ifdef HAVE_X_WINDOWS
4590 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4592 if (FRAME_TERMCAP_P (f
)
4596 face
= FACE_FROM_ID (f
, face_id
);
4597 bcopy (face
->lface
, attrs
, sizeof attrs
);
4598 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4599 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4600 #endif /* HAVE_X_WINDOWS */
4605 /* Return the face id of the realized face for named face SYMBOL on
4606 frame F suitable for displaying characters from CHARSET (CHARSET <
4607 0 means unibyte text), and use attributes of the face FACE_ID for
4608 attributes that aren't completely specified by SYMBOL. This is
4609 like lookup_named_face, except that the default attributes come
4610 from FACE_ID, not from the default face. FACE_ID is assumed to
4611 be already realized. */
4614 lookup_derived_face (f
, symbol
, charset
, face_id
)
4620 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4621 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4622 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4627 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4628 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4629 merge_face_vectors (symbol_attrs
, attrs
);
4630 return lookup_face (f
, attrs
, charset
);
4635 /***********************************************************************
4637 ***********************************************************************/
4639 DEFUN ("internal-set-font-selection-order",
4640 Finternal_set_font_selection_order
,
4641 Sinternal_set_font_selection_order
, 1, 1, 0,
4642 "Set font selection order for face font selection to ORDER.\n\
4643 ORDER must be a list of length 4 containing the symbols `:width',\n\
4644 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4645 first in ORDER are matched first, e.g. if `:height' appears before\n\
4646 `:weight' in ORDER, font selection first tries to find a font with\n\
4647 a suitable height, and then tries to match the font weight.\n\
4656 CHECK_LIST (order
, 0);
4657 bzero (indices
, sizeof indices
);
4661 CONSP (list
) && i
< DIM (indices
);
4662 list
= XCDR (list
), ++i
)
4664 Lisp_Object attr
= XCAR (list
);
4667 if (EQ (attr
, QCwidth
))
4669 else if (EQ (attr
, QCheight
))
4670 xlfd
= XLFD_POINT_SIZE
;
4671 else if (EQ (attr
, QCweight
))
4673 else if (EQ (attr
, QCslant
))
4678 if (indices
[i
] != 0)
4684 || i
!= DIM (indices
)
4689 signal_error ("Invalid font sort order", order
);
4691 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4693 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4694 free_all_realized_faces (Qnil
);
4701 DEFUN ("internal-set-alternative-font-family-alist",
4702 Finternal_set_alternative_font_family_alist
,
4703 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
4704 "Define alternative font families to try in face font selection.\n\
4705 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4706 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
4707 be found. Value is ALIST.")
4711 CHECK_LIST (alist
, 0);
4712 Vface_alternative_font_family_alist
= alist
;
4713 free_all_realized_faces (Qnil
);
4718 #ifdef HAVE_X_WINDOWS
4720 /* Return the X registry and encoding of font name FONT_NAME on frame F.
4721 Value is nil if not successful. */
4724 deduce_unibyte_registry (f
, font_name
)
4728 struct font_name font
;
4729 Lisp_Object registry
= Qnil
;
4731 font
.name
= STRDUPA (font_name
);
4732 if (split_font_name (f
, &font
, 0))
4736 /* Extract registry and encoding. */
4737 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
4738 + strlen (font
.fields
[XLFD_ENCODING
])
4740 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
4741 strcat (buffer
, "-");
4742 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
4743 registry
= build_string (buffer
);
4750 /* Value is non-zero if FONT is the name of a scalable font. The
4751 X11R6 XLFD spec says that point size, pixel size, and average width
4752 are zero for scalable fonts. Intlfonts contain at least one
4753 scalable font ("*-muleindian-1") for which this isn't true, so we
4754 just test average width. */
4757 font_scalable_p (font
)
4758 struct font_name
*font
;
4760 char *s
= font
->fields
[XLFD_AVGWIDTH
];
4761 return *s
== '0' && *(s
+ 1) == '\0';
4765 /* Value is non-zero if FONT1 is a better match for font attributes
4766 VALUES than FONT2. VALUES is an array of face attribute values in
4767 font sort order. COMPARE_PT_P zero means don't compare point
4771 better_font_p (values
, font1
, font2
, compare_pt_p
)
4773 struct font_name
*font1
, *font2
;
4778 for (i
= 0; i
< 4; ++i
)
4780 int xlfd_idx
= font_sort_order
[i
];
4782 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
4784 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
4785 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
4787 if (delta1
> delta2
)
4789 else if (delta1
< delta2
)
4793 /* The difference may be equal because, e.g., the face
4794 specifies `italic' but we have only `regular' and
4795 `oblique'. Prefer `oblique' in this case. */
4796 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
4797 && font1
->numeric
[xlfd_idx
] > values
[i
]
4798 && font2
->numeric
[xlfd_idx
] < values
[i
])
4810 /* Value is non-zero if FONT is an exact match for face attributes in
4811 SPECIFIED. SPECIFIED is an array of face attribute values in font
4815 exact_face_match_p (specified
, font
)
4817 struct font_name
*font
;
4821 for (i
= 0; i
< 4; ++i
)
4822 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
4829 /* Value is the name of a scaled font, generated from scalable font
4830 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
4831 Value is allocated from heap. */
4834 build_scalable_font_name (f
, font
, specified_pt
)
4836 struct font_name
*font
;
4839 char point_size
[20], pixel_size
[20];
4841 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
4844 /* If scalable font is for a specific resolution, compute
4845 the point size we must specify from the resolution of
4846 the display and the specified resolution of the font. */
4847 if (font
->numeric
[XLFD_RESY
] != 0)
4849 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
4850 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
4855 pixel_value
= resy
/ 720.0 * pt
;
4858 /* Set point size of the font. */
4859 sprintf (point_size
, "%d", (int) pt
);
4860 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
4861 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
4863 /* Set pixel size. */
4864 sprintf (pixel_size
, "%d", pixel_value
);
4865 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
4866 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
4868 /* If font doesn't specify its resolution, use the
4869 resolution of the display. */
4870 if (font
->numeric
[XLFD_RESY
] == 0)
4873 sprintf (buffer
, "%d", (int) resy
);
4874 font
->fields
[XLFD_RESY
] = buffer
;
4875 font
->numeric
[XLFD_RESY
] = resy
;
4878 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
4881 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
4882 sprintf (buffer
, "%d", resx
);
4883 font
->fields
[XLFD_RESX
] = buffer
;
4884 font
->numeric
[XLFD_RESX
] = resx
;
4887 return build_font_name (font
);
4891 /* Value is non-zero if we are allowed to use scalable font FONT. We
4892 can't run a Lisp function here since this function may be called
4893 with input blocked. */
4896 may_use_scalable_font_p (font
, name
)
4897 struct font_name
*font
;
4900 if (EQ (Vscalable_fonts_allowed
, Qt
))
4902 else if (CONSP (Vscalable_fonts_allowed
))
4904 Lisp_Object tail
, regexp
;
4906 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
4908 regexp
= XCAR (tail
);
4909 if (STRINGP (regexp
)
4910 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
4918 #endif /* SCALABLE_FONTS != 0 */
4921 /* Return the name of the best matching font for face attributes
4922 ATTRS in the array of font_name structures FONTS which contains
4923 NFONTS elements. Value is a font name which is allocated from
4924 the heap. FONTS is freed by this function. */
4927 best_matching_font (f
, attrs
, fonts
, nfonts
)
4930 struct font_name
*fonts
;
4934 struct font_name
*best
;
4942 /* Make specified font attributes available in `specified',
4943 indexed by sort order. */
4944 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
4946 int xlfd_idx
= font_sort_order
[i
];
4948 if (xlfd_idx
== XLFD_SWIDTH
)
4949 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
4950 else if (xlfd_idx
== XLFD_POINT_SIZE
)
4951 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4952 else if (xlfd_idx
== XLFD_WEIGHT
)
4953 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
4954 else if (xlfd_idx
== XLFD_SLANT
)
4955 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
4965 /* Start with the first non-scalable font in the list. */
4966 for (i
= 0; i
< nfonts
; ++i
)
4967 if (!font_scalable_p (fonts
+ i
))
4970 /* Find the best match among the non-scalable fonts. */
4975 for (i
= 1; i
< nfonts
; ++i
)
4976 if (!font_scalable_p (fonts
+ i
)
4977 && better_font_p (specified
, fonts
+ i
, best
, 1))
4981 exact_p
= exact_face_match_p (specified
, best
);
4990 /* Unless we found an exact match among non-scalable fonts, see if
4991 we can find a better match among scalable fonts. */
4994 /* A scalable font is better if
4996 1. its weight, slant, swidth attributes are better, or.
4998 2. the best non-scalable font doesn't have the required
4999 point size, and the scalable fonts weight, slant, swidth
5002 int non_scalable_has_exact_height_p
;
5004 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5005 non_scalable_has_exact_height_p
= 1;
5007 non_scalable_has_exact_height_p
= 0;
5009 for (i
= 0; i
< nfonts
; ++i
)
5010 if (font_scalable_p (fonts
+ i
))
5013 || better_font_p (specified
, fonts
+ i
, best
, 0)
5014 || (!non_scalable_has_exact_height_p
5015 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5020 if (font_scalable_p (best
))
5021 font_name
= build_scalable_font_name (f
, best
, pt
);
5023 font_name
= build_font_name (best
);
5025 #else /* !SCALABLE_FONTS */
5027 /* Find the best non-scalable font. */
5030 for (i
= 1; i
< nfonts
; ++i
)
5032 xassert (!font_scalable_p (fonts
+ i
));
5033 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5037 font_name
= build_font_name (best
);
5039 #endif /* !SCALABLE_FONTS */
5041 /* Free font_name structures. */
5042 free_font_names (fonts
, nfonts
);
5048 /* Try to get a list of fonts on frame F with font family FAMILY and
5049 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5050 of font_name structures for the fonts matched. Value is the number
5054 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5057 char *pattern
, *family
, *registry
;
5058 struct font_name
**fonts
;
5063 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5065 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5071 /* Try alternative font families from
5072 Vface_alternative_font_family_alist. */
5073 alter
= Fassoc (build_string (family
),
5074 Vface_alternative_font_family_alist
);
5076 for (alter
= XCDR (alter
);
5077 CONSP (alter
) && nfonts
== 0;
5078 alter
= XCDR (alter
))
5080 if (STRINGP (XCAR (alter
)))
5082 family
= LSTRDUPA (XCAR (alter
));
5083 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5087 /* Try font family of the default face or "fixed". */
5090 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5092 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5095 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5098 /* Try any family with the given registry. */
5100 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5107 /* Return the registry and encoding pattern that fonts for CHARSET
5108 should match. Value is allocated from the heap. */
5111 x_charset_registry (charset
)
5114 Lisp_Object prop
, charset_plist
;
5117 /* Get registry and encoding from the charset's plist. */
5118 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5119 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5123 if (index (XSTRING (prop
)->data
, '-'))
5124 registry
= xstrdup (XSTRING (prop
)->data
);
5127 /* If registry doesn't contain a `-', make it a pattern. */
5128 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5129 strcpy (registry
, XSTRING (prop
)->data
);
5130 strcat (registry
, "*-*");
5133 else if (STRINGP (Vface_default_registry
))
5134 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5136 registry
= xstrdup ("iso8859-1");
5142 /* Return the fontset id of the fontset name or alias name given by
5143 the family attribute of ATTRS on frame F. Value is -1 if the
5144 family attribute of ATTRS doesn't name a fontset. */
5147 face_fontset (f
, attrs
)
5151 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5154 name
= Fquery_fontset (name
, Qnil
);
5158 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5164 /* Get the font to use for the face realizing the fully-specified Lisp
5165 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5166 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5167 in this case. Value is the font name which is allocated from the
5168 heap (which means that it must be freed eventually). */
5171 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5175 Lisp_Object unibyte_registry
;
5177 struct font_name
*fonts
;
5181 /* ATTRS must be fully-specified. */
5182 xassert (lface_fully_specified_p (attrs
));
5184 if (STRINGP (unibyte_registry
))
5185 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5187 registry
= x_charset_registry (charset
);
5189 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5191 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5195 /* Choose a font to use on frame F to display CHARSET using FONTSET
5196 with Lisp face attributes specified by ATTRS. CHARSET may be any
5197 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
5198 unibyte text. If the fontset doesn't contain a font pattern for
5199 charset, use the pattern for CHARSET_ASCII. Value is the font name
5200 which is allocated from the heap and must be freed by the caller. */
5203 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5206 int fontset
, charset
;
5209 char *font_name
= NULL
;
5210 struct fontset_info
*fontset_info
;
5211 struct font_name
*fonts
;
5214 xassert (charset
!= CHARSET_COMPOSITION
);
5215 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5217 /* For unibyte text, use the ASCII font of the fontset. Using the
5218 ASCII font seems to be the most reasonable thing we can do in
5221 charset
= CHARSET_ASCII
;
5223 /* Get the font name pattern to use for CHARSET from the fontset. */
5224 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5225 pattern
= fontset_info
->fontname
[charset
];
5227 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5230 /* Get a list of fonts matching that pattern and choose the
5231 best match for the specified face attributes from it. */
5232 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5233 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5237 #endif /* HAVE_X_WINDOWS */
5241 /***********************************************************************
5243 ***********************************************************************/
5245 /* Realize basic faces on frame F. Value is zero if frame parameters
5246 of F don't contain enough information needed to realize the default
5250 realize_basic_faces (f
)
5255 if (realize_default_face (f
))
5257 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5258 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5259 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5260 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5261 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5262 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5263 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5264 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5272 /* Realize the default face on frame F. If the face is not fully
5273 specified, make it fully-specified. Attributes of the default face
5274 that are not explicitly specified are taken from frame parameters. */
5277 realize_default_face (f
)
5280 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5282 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5283 Lisp_Object unibyte_registry
;
5284 Lisp_Object frame_font
;
5288 /* If the `default' face is not yet known, create it. */
5289 lface
= lface_from_face_name (f
, Qdefault
, 0);
5293 XSETFRAME (frame
, f
);
5294 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5297 #ifdef HAVE_X_WINDOWS
5300 /* Set frame_font to the value of the `font' frame parameter. */
5301 frame_font
= Fassq (Qfont
, f
->param_alist
);
5302 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5303 frame_font
= XCDR (frame_font
);
5305 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5308 /* If frame_font is a fontset name, don't use that for
5309 determining font-related attributes of the default face
5310 because it is just an artificial name. Use the ASCII font of
5311 the fontset, instead. */
5312 struct font_info
*font_info
;
5313 struct font_name font
;
5316 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5320 /* Set weight etc. from the ASCII font. */
5321 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0))
5324 /* Remember registry and encoding of the frame font. */
5325 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5326 if (STRINGP (unibyte_registry
))
5327 Vface_default_registry
= unibyte_registry
;
5329 Vface_default_registry
= build_string ("iso8859-1");
5331 /* But set the family to the fontset alias name. Implementation
5332 note: When a font is passed to Emacs via `-fn FONT', a
5333 fontset is created in `x-win.el' whose name ends in
5334 `fontset-startup'. This fontset has an alias name that is
5335 equal to frame_font. */
5336 xassert (STRINGP (frame_font
));
5337 font
.name
= LSTRDUPA (frame_font
);
5339 if (!split_font_name (f
, &font
, 1)
5340 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5341 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5342 LFACE_FAMILY (lface
) = frame_font
;
5346 /* Frame parameters contain a real font. Fill default face
5347 attributes from that font. */
5348 if (!set_lface_from_font_name (f
, lface
,
5349 XSTRING (frame_font
)->data
, 0))
5352 /* Remember registry and encoding of the frame font. */
5354 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5355 if (STRINGP (unibyte_registry
))
5356 Vface_default_registry
= unibyte_registry
;
5358 Vface_default_registry
= build_string ("iso8859-1");
5361 #endif /* HAVE_X_WINDOWS */
5363 if (!FRAME_WINDOW_P (f
))
5365 LFACE_FAMILY (lface
) = build_string ("default");
5366 LFACE_SWIDTH (lface
) = Qnormal
;
5367 LFACE_HEIGHT (lface
) = make_number (1);
5368 LFACE_WEIGHT (lface
) = Qnormal
;
5369 LFACE_SLANT (lface
) = Qnormal
;
5372 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5373 LFACE_UNDERLINE (lface
) = Qnil
;
5375 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5376 LFACE_OVERLINE (lface
) = Qnil
;
5378 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5379 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5381 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5382 LFACE_BOX (lface
) = Qnil
;
5384 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5385 LFACE_INVERSE (lface
) = Qnil
;
5387 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5389 /* This function is called so early that colors are not yet
5390 set in the frame parameter list. */
5391 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5393 if (CONSP (color
) && STRINGP (XCDR (color
)))
5394 LFACE_FOREGROUND (lface
) = XCDR (color
);
5395 else if (FRAME_X_P (f
))
5397 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5398 /* Frame parameters for terminal frames usually don't contain
5399 a color. Use an empty string to indicate that the face
5400 should use the (unknown) default color of the terminal. */
5401 LFACE_FOREGROUND (lface
) = build_string ("");
5406 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5408 /* This function is called so early that colors are not yet
5409 set in the frame parameter list. */
5410 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5411 if (CONSP (color
) && STRINGP (XCDR (color
)))
5412 LFACE_BACKGROUND (lface
) = XCDR (color
);
5413 else if (FRAME_X_P (f
))
5415 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5416 /* Frame parameters for terminal frames usually don't contain
5417 a color. Use an empty string to indicate that the face
5418 should use the (unknown) default color of the terminal. */
5419 LFACE_BACKGROUND (lface
) = build_string ("");
5424 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5425 LFACE_STIPPLE (lface
) = Qnil
;
5427 /* Realize the face; it must be fully-specified now. */
5428 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5429 check_lface (lface
);
5430 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5431 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5433 /* Remove the former default face. */
5434 if (c
->used
> DEFAULT_FACE_ID
)
5436 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5437 uncache_face (c
, default_face
);
5438 free_realized_face (f
, default_face
);
5441 /* Insert the new default face. */
5442 cache_face (c
, face
, lface_hash (attrs
));
5443 xassert (face
->id
== DEFAULT_FACE_ID
);
5448 /* Realize basic faces other than the default face in face cache C.
5449 SYMBOL is the face name, ID is the face id the realized face must
5450 have. The default face must have been realized already. */
5453 realize_named_face (f
, symbol
, id
)
5458 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5459 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5460 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5461 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5462 struct face
*new_face
;
5464 /* The default face must exist and be fully specified. */
5465 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5466 check_lface_attrs (attrs
);
5467 xassert (lface_fully_specified_p (attrs
));
5469 /* If SYMBOL isn't know as a face, create it. */
5473 XSETFRAME (frame
, f
);
5474 lface
= Finternal_make_lisp_face (symbol
, frame
);
5477 /* Merge SYMBOL's face with the default face. */
5478 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5479 merge_face_vectors (symbol_attrs
, attrs
);
5481 /* Realize the face. */
5482 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5484 /* Remove the former face. */
5487 struct face
*old_face
= c
->faces_by_id
[id
];
5488 uncache_face (c
, old_face
);
5489 free_realized_face (f
, old_face
);
5492 /* Insert the new face. */
5493 cache_face (c
, new_face
, lface_hash (attrs
));
5494 xassert (new_face
->id
== id
);
5498 /* Realize the fully-specified face with attributes ATTRS in face
5499 cache C for character set CHARSET or for unibyte text if CHARSET <
5500 0. Value is a pointer to the newly created realized face. */
5502 static struct face
*
5503 realize_face (c
, attrs
, charset
)
5504 struct face_cache
*c
;
5510 /* LFACE must be fully specified. */
5511 xassert (c
!= NULL
);
5512 check_lface_attrs (attrs
);
5514 if (FRAME_X_P (c
->f
))
5515 face
= realize_x_face (c
, attrs
, charset
);
5516 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5517 face
= realize_tty_face (c
, attrs
, charset
);
5525 /* Realize the fully-specified face with attributes ATTRS in face
5526 cache C for character set CHARSET or for unibyte text if CHARSET <
5527 0. Do it for X frame C->f. Value is a pointer to the newly
5528 created realized face. */
5530 static struct face
*
5531 realize_x_face (c
, attrs
, charset
)
5532 struct face_cache
*c
;
5536 #ifdef HAVE_X_WINDOWS
5537 struct face
*face
, *default_face
;
5538 struct frame
*f
= c
->f
;
5539 Lisp_Object stipple
, overline
, strike_through
, box
;
5540 Lisp_Object unibyte_registry
;
5541 struct gcpro gcpro1
;
5543 xassert (FRAME_X_P (f
));
5545 /* If realizing a face for use in unibyte text, get the X registry
5546 and encoding to use from Vface_default_registry. */
5548 unibyte_registry
= (STRINGP (Vface_default_registry
)
5549 ? Vface_default_registry
5550 : build_string ("iso8859-1"));
5552 unibyte_registry
= Qnil
;
5553 GCPRO1 (unibyte_registry
);
5555 /* Allocate a new realized face. */
5556 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5558 /* Determine the font to use. Most of the time, the font will be
5559 the same as the font of the default face, so try that first. */
5560 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5562 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5563 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5565 face
->font
= default_face
->font
;
5566 face
->fontset
= default_face
->fontset
;
5567 face
->font_info_id
= default_face
->font_info_id
;
5568 face
->font_name
= default_face
->font_name
;
5569 face
->registry
= default_face
->registry
;
5571 else if (charset
>= 0)
5573 /* For all charsets except CHARSET_COMPOSITION, we use our own
5574 font selection functions to choose a best matching font for
5575 the specified face attributes. If the face specifies a
5576 fontset alias name, the fontset determines the font name
5577 pattern, otherwise we construct a font pattern from face
5578 attributes and charset.
5580 If charset is CHARSET_COMPOSITION, we always construct a face
5581 with a fontset, even if the face doesn't specify a fontset alias
5582 (we use fontset-standard in that case). When the composite
5583 character is displayed in xterm.c, a suitable concrete font is
5584 loaded in x_get_char_font_and_encoding. */
5586 char *font_name
= NULL
;
5587 int fontset
= face_fontset (f
, attrs
);
5589 if (charset
== CHARSET_COMPOSITION
)
5590 fontset
= max (0, fontset
);
5591 else if (fontset
< 0)
5592 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5595 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5599 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5604 /* Unibyte case, and font is not equal to that of the default
5605 face. UNIBYTE_REGISTRY is the X registry and encoding the
5606 font should have. What is a reasonable thing to do if the
5607 user specified a fontset alias name for the face in this
5608 case? We choose a font by taking the ASCII font of the
5609 fontset, but using UNIBYTE_REGISTRY for its registry and
5612 char *font_name
= NULL
;
5613 int fontset
= face_fontset (f
, attrs
);
5616 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5618 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5620 load_face_font_or_fontset (f
, face
, font_name
, -1);
5624 /* Load colors, and set remaining attributes. */
5626 load_face_colors (f
, face
, attrs
);
5629 box
= attrs
[LFACE_BOX_INDEX
];
5632 /* A simple box of line width 1 drawn in color given by
5634 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5636 face
->box
= FACE_SIMPLE_BOX
;
5637 face
->box_line_width
= 1;
5639 else if (INTEGERP (box
))
5641 /* Simple box of specified line width in foreground color of the
5643 xassert (XINT (box
) > 0);
5644 face
->box
= FACE_SIMPLE_BOX
;
5645 face
->box_line_width
= XFASTINT (box
);
5646 face
->box_color
= face
->foreground
;
5647 face
->box_color_defaulted_p
= 1;
5649 else if (CONSP (box
))
5651 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5652 being one of `raised' or `sunken'. */
5653 face
->box
= FACE_SIMPLE_BOX
;
5654 face
->box_color
= face
->foreground
;
5655 face
->box_color_defaulted_p
= 1;
5656 face
->box_line_width
= 1;
5660 Lisp_Object keyword
, value
;
5662 keyword
= XCAR (box
);
5670 if (EQ (keyword
, QCline_width
))
5672 if (INTEGERP (value
) && XINT (value
) > 0)
5673 face
->box_line_width
= XFASTINT (value
);
5675 else if (EQ (keyword
, QCcolor
))
5677 if (STRINGP (value
))
5679 face
->box_color
= load_color (f
, face
, value
,
5681 face
->use_box_color_for_shadows_p
= 1;
5684 else if (EQ (keyword
, QCstyle
))
5686 if (EQ (value
, Qreleased_button
))
5687 face
->box
= FACE_RAISED_BOX
;
5688 else if (EQ (value
, Qpressed_button
))
5689 face
->box
= FACE_SUNKEN_BOX
;
5694 /* Text underline, overline, strike-through. */
5696 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5698 /* Use default color (same as foreground color). */
5699 face
->underline_p
= 1;
5700 face
->underline_defaulted_p
= 1;
5701 face
->underline_color
= 0;
5703 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5705 /* Use specified color. */
5706 face
->underline_p
= 1;
5707 face
->underline_defaulted_p
= 0;
5708 face
->underline_color
5709 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5710 LFACE_UNDERLINE_INDEX
);
5712 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5714 face
->underline_p
= 0;
5715 face
->underline_defaulted_p
= 0;
5716 face
->underline_color
= 0;
5719 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5720 if (STRINGP (overline
))
5722 face
->overline_color
5723 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5724 LFACE_OVERLINE_INDEX
);
5725 face
->overline_p
= 1;
5727 else if (EQ (overline
, Qt
))
5729 face
->overline_color
= face
->foreground
;
5730 face
->overline_color_defaulted_p
= 1;
5731 face
->overline_p
= 1;
5734 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5735 if (STRINGP (strike_through
))
5737 face
->strike_through_color
5738 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5739 LFACE_STRIKE_THROUGH_INDEX
);
5740 face
->strike_through_p
= 1;
5742 else if (EQ (strike_through
, Qt
))
5744 face
->strike_through_color
= face
->foreground
;
5745 face
->strike_through_color_defaulted_p
= 1;
5746 face
->strike_through_p
= 1;
5749 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5750 if (!NILP (stipple
))
5751 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5754 xassert (face
->fontset
< 0 || face
->charset
== CHARSET_COMPOSITION
);
5755 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
5757 #endif /* HAVE_X_WINDOWS */
5761 /* Realize the fully-specified face with attributes ATTRS in face
5762 cache C for character set CHARSET or for unibyte text if CHARSET <
5763 0. Do it for TTY frame C->f. Value is a pointer to the newly
5764 created realized face. */
5766 static struct face
*
5767 realize_tty_face (c
, attrs
, charset
)
5768 struct face_cache
*c
;
5776 /* Frame must be a termcap frame. */
5777 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
5779 /* Allocate a new realized face. */
5780 face
= make_realized_face (attrs
, charset
, Qnil
);
5781 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
5783 /* Map face attributes to TTY appearances. We map slant to
5784 dimmed text because we want italic text to appear differently
5785 and because dimmed text is probably used infrequently. */
5786 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5787 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5789 if (weight
> XLFD_WEIGHT_MEDIUM
)
5790 face
->tty_bold_p
= 1;
5791 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
5792 face
->tty_dim_p
= 1;
5793 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5794 face
->tty_underline_p
= 1;
5795 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5796 face
->tty_reverse_p
= 1;
5798 /* Map color names to color indices. */
5799 face
->foreground
= face
->background
= FACE_TTY_DEFAULT_COLOR
;
5801 color
= attrs
[LFACE_FOREGROUND_INDEX
];
5802 if (XSTRING (color
)->size
5803 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5805 face
->foreground
= XINT (XCDR (color
));
5808 if (FRAME_MSDOS_P (c
->f
) && face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
5810 face
->foreground
= load_color (c
->f
, face
,
5811 attrs
[LFACE_FOREGROUND_INDEX
],
5812 LFACE_FOREGROUND_INDEX
);
5813 /* If the foreground of the default face is the default color,
5814 use the foreground color defined by the frame. */
5815 if (face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
5817 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
5818 attrs
[LFACE_FOREGROUND_INDEX
] =
5819 build_string (msdos_stdcolor_name (face
->foreground
));
5824 color
= attrs
[LFACE_BACKGROUND_INDEX
];
5825 if (XSTRING (color
)->size
5826 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5828 face
->background
= XINT (XCDR (color
));
5831 if (FRAME_MSDOS_P (c
->f
) && face
->background
== FACE_TTY_DEFAULT_COLOR
)
5833 face
->background
= load_color (c
->f
, face
,
5834 attrs
[LFACE_BACKGROUND_INDEX
],
5835 LFACE_BACKGROUND_INDEX
);
5836 /* If the background of the default face is the default color,
5837 use the background color defined by the frame. */
5838 if (face
->background
== FACE_TTY_DEFAULT_COLOR
)
5840 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
5841 attrs
[LFACE_BACKGROUND_INDEX
] =
5842 build_string (msdos_stdcolor_name (face
->background
));
5846 /* Swap colors if face is inverse-video. */
5847 if (face
->tty_reverse_p
)
5849 unsigned long tem
= face
->foreground
;
5851 face
->foreground
= face
->background
;
5852 face
->background
= tem
;
5860 DEFUN ("face-register-tty-color", Fface_register_tty_color
,
5861 Sface_register_tty_color
, 2, 2, 0,
5862 "Say that COLOR is color number NUMBER on the terminal.\n\
5863 COLOR is a string, the color name. Value is COLOR.")
5865 Lisp_Object color
, number
;
5869 CHECK_STRING (color
, 0);
5870 CHECK_NUMBER (number
, 1);
5871 entry
= Fassoc (color
, Vface_tty_color_alist
);
5873 Vface_tty_color_alist
= Fcons (Fcons (color
, number
),
5874 Vface_tty_color_alist
);
5876 Fsetcdr (entry
, number
);
5881 DEFUN ("face-clear-tty-colors", Fface_clear_tty_colors
,
5882 Sface_clear_tty_colors
, 0, 0, 0,
5883 "Unregister all registered tty colors.")
5886 return Vface_tty_color_alist
= Qnil
;
5890 DEFUN ("tty-defined-colors", Ftty_defined_colors
,
5891 Stty_defined_colors
, 0, 0, 0,
5892 "Return a list of registered tty colors.")
5895 Lisp_Object list
, colors
;
5898 for (list
= Vface_tty_color_alist
; CONSP (list
); list
= XCDR (list
))
5899 colors
= Fcons (XCAR (XCAR (list
)), colors
);
5906 /***********************************************************************
5908 ***********************************************************************/
5910 /* Return the ID of the face to use to display character CH with face
5911 property PROP on frame F in current_buffer. */
5914 compute_char_face (f
, ch
, prop
)
5920 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
5922 : CHAR_CHARSET (ch
));
5925 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
5928 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5929 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5930 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5931 merge_face_vector_with_property (f
, attrs
, prop
);
5932 face_id
= lookup_face (f
, attrs
, charset
);
5939 /* Return the face ID associated with buffer position POS for
5940 displaying ASCII characters. Return in *ENDPTR the position at
5941 which a different face is needed, as far as text properties and
5942 overlays are concerned. W is a window displaying current_buffer.
5944 REGION_BEG, REGION_END delimit the region, so it can be
5947 LIMIT is a position not to scan beyond. That is to limit the time
5948 this function can take.
5950 If MOUSE is non-zero, use the character's mouse-face, not its face.
5952 The face returned is suitable for displaying CHARSET_ASCII if
5953 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
5954 the face is suitable for displaying unibyte text. */
5957 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
5958 endptr
, limit
, mouse
)
5961 int region_beg
, region_end
;
5966 struct frame
*f
= XFRAME (w
->frame
);
5967 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5968 Lisp_Object prop
, position
;
5970 Lisp_Object
*overlay_vec
;
5973 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5974 Lisp_Object limit1
, end
;
5975 struct face
*default_face
;
5976 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
5978 /* W must display the current buffer. We could write this function
5979 to use the frame and buffer of W, but right now it doesn't. */
5980 /* xassert (XBUFFER (w->buffer) == current_buffer); */
5982 XSETFRAME (frame
, f
);
5983 XSETFASTINT (position
, pos
);
5986 if (pos
< region_beg
&& region_beg
< endpos
)
5987 endpos
= region_beg
;
5989 /* Get the `face' or `mouse_face' text property at POS, and
5990 determine the next position at which the property changes. */
5991 prop
= Fget_text_property (position
, propname
, w
->buffer
);
5992 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5993 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
5995 endpos
= XINT (end
);
5997 /* Look at properties from overlays. */
6002 /* First try with room for 40 overlays. */
6004 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6005 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6006 &next_overlay
, NULL
);
6008 /* If there are more than 40, make enough space for all, and try
6010 if (noverlays
> len
)
6013 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6014 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6015 &next_overlay
, NULL
);
6018 if (next_overlay
< endpos
)
6019 endpos
= next_overlay
;
6024 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6026 /* Optimize common cases where we can use the default face. */
6029 && !(pos
>= region_beg
&& pos
< region_end
)
6031 || !FRAME_WINDOW_P (f
)
6032 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6033 return DEFAULT_FACE_ID
;
6035 /* Begin with attributes from the default face. */
6036 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6038 /* Merge in attributes specified via text properties. */
6040 merge_face_vector_with_property (f
, attrs
, prop
);
6042 /* Now merge the overlay data. */
6043 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6044 for (i
= 0; i
< noverlays
; i
++)
6049 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6051 merge_face_vector_with_property (f
, attrs
, prop
);
6053 oend
= OVERLAY_END (overlay_vec
[i
]);
6054 oendpos
= OVERLAY_POSITION (oend
);
6055 if (oendpos
< endpos
)
6059 /* If in the region, merge in the region face. */
6060 if (pos
>= region_beg
&& pos
< region_end
)
6062 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6063 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6065 if (region_end
< endpos
)
6066 endpos
= region_end
;
6071 /* Look up a realized face with the given face attributes,
6072 or realize a new one. Charset is ignored for tty frames. */
6073 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6077 /* Compute the face at character position POS in Lisp string STRING on
6078 window W, for charset CHARSET_ASCII.
6080 If STRING is an overlay string, it comes from position BUFPOS in
6081 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6082 not an overlay string. W must display the current buffer.
6083 REGION_BEG and REGION_END give the start and end positions of the
6084 region; both are -1 if no region is visible. BASE_FACE_ID is the
6085 id of the basic face to merge with. It is usually equal to
6086 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6087 for strings displayed in the mode or top line.
6089 Set *ENDPTR to the next position where to check for faces in
6090 STRING; -1 if the face is constant from POS to the end of the
6093 Value is the id of the face to use. The face returned is suitable
6094 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6095 the face is suitable for displaying unibyte text. */
6098 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6099 region_end
, endptr
, base_face_id
)
6103 int region_beg
, region_end
;
6105 enum face_id base_face_id
;
6107 Lisp_Object prop
, position
, end
, limit
;
6108 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6109 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6110 struct face
*base_face
;
6111 int multibyte_p
= STRING_MULTIBYTE (string
);
6113 /* Get the value of the face property at the current position within
6114 STRING. Value is nil if there is no face property. */
6115 XSETFASTINT (position
, pos
);
6116 prop
= Fget_text_property (position
, Qface
, string
);
6118 /* Get the next position at which to check for faces. Value of end
6119 is nil if face is constant all the way to the end of the string.
6120 Otherwise it is a string position where to check faces next.
6121 Limit is the maximum position up to which to check for property
6122 changes in Fnext_single_property_change. Strings are usually
6123 short, so set the limit to the end of the string. */
6124 XSETFASTINT (limit
, XSTRING (string
)->size
);
6125 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6127 *endptr
= XFASTINT (end
);
6131 base_face
= FACE_FROM_ID (f
, base_face_id
);
6132 xassert (base_face
);
6134 /* Optimize the default case that there is no face property and we
6135 are not in the region. */
6137 && (base_face_id
!= DEFAULT_FACE_ID
6138 /* BUFPOS <= 0 means STRING is not an overlay string, so
6139 that the region doesn't have to be taken into account. */
6141 || bufpos
< region_beg
6142 || bufpos
>= region_end
)
6144 /* We can't realize faces for different charsets differently
6145 if we don't have fonts, so we can stop here if not working
6146 on a window-system frame. */
6147 || !FRAME_WINDOW_P (f
)
6148 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6149 return base_face
->id
;
6151 /* Begin with attributes from the base face. */
6152 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6154 /* Merge in attributes specified via text properties. */
6156 merge_face_vector_with_property (f
, attrs
, prop
);
6158 /* If in the region, merge in the region face. */
6160 && bufpos
>= region_beg
6161 && bufpos
< region_end
)
6163 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6164 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6167 /* Look up a realized face with the given face attributes,
6168 or realize a new one. */
6169 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6174 /***********************************************************************
6176 ***********************************************************************/
6180 /* Print the contents of the realized face FACE to stderr. */
6183 dump_realized_face (face
)
6186 fprintf (stderr
, "ID: %d\n", face
->id
);
6187 #ifdef HAVE_X_WINDOWS
6188 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6190 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6192 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6193 fprintf (stderr
, "background: 0x%lx (%s)\n",
6195 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6196 fprintf (stderr
, "font_name: %s (%s)\n",
6198 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6199 #ifdef HAVE_X_WINDOWS
6200 fprintf (stderr
, "font = %p\n", face
->font
);
6202 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6203 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6204 fprintf (stderr
, "underline: %d (%s)\n",
6206 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6207 fprintf (stderr
, "hash: %d\n", face
->hash
);
6208 fprintf (stderr
, "charset: %d\n", face
->charset
);
6212 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6220 fprintf (stderr
, "font selection order: ");
6221 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6222 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6223 fprintf (stderr
, "\n");
6225 fprintf (stderr
, "alternative fonts: ");
6226 debug_print (Vface_alternative_font_family_alist
);
6227 fprintf (stderr
, "\n");
6229 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6230 Fdump_face (make_number (i
));
6235 CHECK_NUMBER (n
, 0);
6236 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6238 error ("Not a valid face");
6239 dump_realized_face (face
);
6246 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6250 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6251 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6252 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6256 #endif /* GLYPH_DEBUG != 0 */
6260 /***********************************************************************
6262 ***********************************************************************/
6267 Qface
= intern ("face");
6269 Qpixmap_spec_p
= intern ("pixmap-spec-p");
6270 staticpro (&Qpixmap_spec_p
);
6271 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6272 staticpro (&Qframe_update_face_colors
);
6274 /* Lisp face attribute keywords. */
6275 QCfamily
= intern (":family");
6276 staticpro (&QCfamily
);
6277 QCheight
= intern (":height");
6278 staticpro (&QCheight
);
6279 QCweight
= intern (":weight");
6280 staticpro (&QCweight
);
6281 QCslant
= intern (":slant");
6282 staticpro (&QCslant
);
6283 QCunderline
= intern (":underline");
6284 staticpro (&QCunderline
);
6285 QCinverse_video
= intern (":inverse-video");
6286 staticpro (&QCinverse_video
);
6287 QCreverse_video
= intern (":reverse-video");
6288 staticpro (&QCreverse_video
);
6289 QCforeground
= intern (":foreground");
6290 staticpro (&QCforeground
);
6291 QCbackground
= intern (":background");
6292 staticpro (&QCbackground
);
6293 QCstipple
= intern (":stipple");;
6294 staticpro (&QCstipple
);
6295 QCwidth
= intern (":width");
6296 staticpro (&QCwidth
);
6297 QCfont
= intern (":font");
6298 staticpro (&QCfont
);
6299 QCbold
= intern (":bold");
6300 staticpro (&QCbold
);
6301 QCitalic
= intern (":italic");
6302 staticpro (&QCitalic
);
6303 QCoverline
= intern (":overline");
6304 staticpro (&QCoverline
);
6305 QCstrike_through
= intern (":strike-through");
6306 staticpro (&QCstrike_through
);
6307 QCbox
= intern (":box");
6310 /* Symbols used for Lisp face attribute values. */
6311 QCcolor
= intern (":color");
6312 staticpro (&QCcolor
);
6313 QCline_width
= intern (":line-width");
6314 staticpro (&QCline_width
);
6315 QCstyle
= intern (":style");
6316 staticpro (&QCstyle
);
6317 Qreleased_button
= intern ("released-button");
6318 staticpro (&Qreleased_button
);
6319 Qpressed_button
= intern ("pressed-button");
6320 staticpro (&Qpressed_button
);
6321 Qnormal
= intern ("normal");
6322 staticpro (&Qnormal
);
6323 Qultra_light
= intern ("ultra-light");
6324 staticpro (&Qultra_light
);
6325 Qextra_light
= intern ("extra-light");
6326 staticpro (&Qextra_light
);
6327 Qlight
= intern ("light");
6328 staticpro (&Qlight
);
6329 Qsemi_light
= intern ("semi-light");
6330 staticpro (&Qsemi_light
);
6331 Qsemi_bold
= intern ("semi-bold");
6332 staticpro (&Qsemi_bold
);
6333 Qbold
= intern ("bold");
6335 Qextra_bold
= intern ("extra-bold");
6336 staticpro (&Qextra_bold
);
6337 Qultra_bold
= intern ("ultra-bold");
6338 staticpro (&Qultra_bold
);
6339 Qoblique
= intern ("oblique");
6340 staticpro (&Qoblique
);
6341 Qitalic
= intern ("italic");
6342 staticpro (&Qitalic
);
6343 Qreverse_oblique
= intern ("reverse-oblique");
6344 staticpro (&Qreverse_oblique
);
6345 Qreverse_italic
= intern ("reverse-italic");
6346 staticpro (&Qreverse_italic
);
6347 Qultra_condensed
= intern ("ultra-condensed");
6348 staticpro (&Qultra_condensed
);
6349 Qextra_condensed
= intern ("extra-condensed");
6350 staticpro (&Qextra_condensed
);
6351 Qcondensed
= intern ("condensed");
6352 staticpro (&Qcondensed
);
6353 Qsemi_condensed
= intern ("semi-condensed");
6354 staticpro (&Qsemi_condensed
);
6355 Qsemi_expanded
= intern ("semi-expanded");
6356 staticpro (&Qsemi_expanded
);
6357 Qexpanded
= intern ("expanded");
6358 staticpro (&Qexpanded
);
6359 Qextra_expanded
= intern ("extra-expanded");
6360 staticpro (&Qextra_expanded
);
6361 Qultra_expanded
= intern ("ultra-expanded");
6362 staticpro (&Qultra_expanded
);
6363 Qbackground_color
= intern ("background-color");
6364 staticpro (&Qbackground_color
);
6365 Qforeground_color
= intern ("foreground-color");
6366 staticpro (&Qforeground_color
);
6367 Qunspecified
= intern ("unspecified");
6368 staticpro (&Qunspecified
);
6370 Qx_charset_registry
= intern ("x-charset-registry");
6371 staticpro (&Qx_charset_registry
);
6372 Qface_alias
= intern ("face-alias");
6373 staticpro (&Qface_alias
);
6374 Qdefault
= intern ("default");
6375 staticpro (&Qdefault
);
6376 Qmode_line
= intern ("mode-line");
6377 staticpro (&Qmode_line
);
6378 Qtool_bar
= intern ("tool-bar");
6379 staticpro (&Qtool_bar
);
6380 Qregion
= intern ("region");
6381 staticpro (&Qregion
);
6382 Qfringe
= intern ("fringe");
6383 staticpro (&Qfringe
);
6384 Qheader_line
= intern ("header-line");
6385 staticpro (&Qheader_line
);
6386 Qscroll_bar
= intern ("scroll-bar");
6387 staticpro (&Qscroll_bar
);
6388 Qcursor
= intern ("cursor");
6389 staticpro (&Qcursor
);
6390 Qborder
= intern ("border");
6391 staticpro (&Qborder
);
6392 Qmouse
= intern ("mouse");
6393 staticpro (&Qmouse
);
6395 defsubr (&Sinternal_make_lisp_face
);
6396 defsubr (&Sinternal_lisp_face_p
);
6397 defsubr (&Sinternal_set_lisp_face_attribute
);
6398 #ifdef HAVE_X_WINDOWS
6399 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6400 defsubr (&Sface_color_gray_p
);
6401 defsubr (&Sface_color_supported_p
);
6403 defsubr (&Sinternal_get_lisp_face_attribute
);
6404 defsubr (&Sinternal_lisp_face_attribute_values
);
6405 defsubr (&Sinternal_lisp_face_equal_p
);
6406 defsubr (&Sinternal_lisp_face_empty_p
);
6407 defsubr (&Sinternal_copy_lisp_face
);
6408 defsubr (&Sinternal_merge_in_global_face
);
6409 defsubr (&Sface_font
);
6410 defsubr (&Sframe_face_alist
);
6411 defsubr (&Sinternal_set_font_selection_order
);
6412 defsubr (&Sinternal_set_alternative_font_family_alist
);
6414 defsubr (&Sdump_face
);
6415 defsubr (&Sshow_face_resources
);
6416 #endif /* GLYPH_DEBUG */
6417 defsubr (&Sclear_face_cache
);
6419 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6420 "*Limit for font matching.\n\
6421 If an integer > 0, font matching functions won't load more than\n\
6422 that number of fonts when searching for a matching font.");
6423 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6425 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6426 "List of global face definitions (for internal use only.)");
6427 Vface_new_frame_defaults
= Qnil
;
6429 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6430 "*Default stipple pattern used on monochrome displays.\n\
6431 This stipple pattern is used on monochrome displays\n\
6432 instead of shades of gray for a face background color.\n\
6433 See `set-face-stipple' for possible values for this variable.");
6434 Vface_default_stipple
= build_string ("gray3");
6436 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6437 "Default registry and encoding to use.\n\
6438 This registry and encoding is used for unibyte text. It is set up\n\
6439 from the specified frame font when Emacs starts. (For internal use only.)");
6440 Vface_default_registry
= Qnil
;
6442 DEFVAR_LISP ("face-alternative-font-family-alist",
6443 &Vface_alternative_font_family_alist
, "");
6444 Vface_alternative_font_family_alist
= Qnil
;
6448 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6449 "Allowed scalable fonts.\n\
6450 A value of nil means don't allow any scalable fonts.\n\
6451 A value of t means allow any scalable font.\n\
6452 Otherwise, value must be a list of regular expressions. A font may be\n\
6453 scaled if its name matches a regular expression in the list.");
6454 Vscalable_fonts_allowed
= Qnil
;
6456 #endif /* SCALABLE_FONTS */
6458 #ifdef HAVE_X_WINDOWS
6459 defsubr (&Spixmap_spec_p
);
6460 defsubr (&Sx_list_fonts
);
6461 defsubr (&Sinternal_face_x_get_resource
);
6462 defsubr (&Sx_family_fonts
);
6463 defsubr (&Sx_font_family_list
);
6464 #endif /* HAVE_X_WINDOWS */
6466 /* TTY face support. */
6467 defsubr (&Sface_register_tty_color
);
6468 defsubr (&Sface_clear_tty_colors
);
6469 defsubr (&Stty_defined_colors
);
6470 Vface_tty_color_alist
= Qnil
;
6471 staticpro (&Vface_tty_color_alist
);