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 selected_frame. Otherwise, check that
641 FRAME is a live frame, and return a pointer to it. NPARAM
642 is the parameter number of FRAME, for CHECK_LIVE_FRAME. This is
643 here because it's a frequent pattern in Lisp function definitions. */
645 static INLINE
struct frame
*
646 frame_or_selected_frame (frame
, nparam
)
656 CHECK_LIVE_FRAME (frame
, nparam
);
664 /***********************************************************************
666 ***********************************************************************/
668 /* Initialize face cache and basic faces for frame F. */
674 /* Make a face cache, if F doesn't have one. */
675 if (FRAME_FACE_CACHE (f
) == NULL
)
676 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
678 #ifdef HAVE_X_WINDOWS
679 /* Make the image cache. */
682 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
683 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
684 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
686 #endif /* HAVE_X_WINDOWS */
688 /* Realize basic faces. Must have enough information in frame
689 parameters to realize basic faces at this point. */
690 #ifdef HAVE_X_WINDOWS
691 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
693 if (!realize_basic_faces (f
))
698 /* Free face cache of frame F. Called from Fdelete_frame. */
704 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
708 free_face_cache (face_cache
);
709 FRAME_FACE_CACHE (f
) = NULL
;
712 #ifdef HAVE_X_WINDOWS
715 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
718 --image_cache
->refcount
;
719 if (image_cache
->refcount
== 0)
720 free_image_cache (f
);
723 #endif /* HAVE_X_WINDOWS */
727 /* Clear face caches, and recompute basic faces for frame F. Call
728 this after changing frame parameters on which those faces depend,
729 or when realized faces have been freed due to changing attributes
733 recompute_basic_faces (f
)
736 if (FRAME_FACE_CACHE (f
))
739 clear_face_cache (0);
740 realized_p
= realize_basic_faces (f
);
741 xassert (realized_p
);
746 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
747 try to free unused fonts, too. */
750 clear_face_cache (clear_fonts_p
)
753 #ifdef HAVE_X_WINDOWS
754 Lisp_Object tail
, frame
;
758 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
760 /* From time to time see if we can unload some fonts. This also
761 frees all realized faces on all frames. Fonts needed by
762 faces will be loaded again when faces are realized again. */
763 clear_font_table_count
= 0;
765 FOR_EACH_FRAME (tail
, frame
)
769 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
771 free_all_realized_faces (frame
);
772 clear_font_table (f
);
778 /* Clear GCs of realized faces. */
779 FOR_EACH_FRAME (tail
, frame
)
784 clear_face_gcs (FRAME_FACE_CACHE (f
));
785 clear_image_cache (f
, 0);
789 #endif /* HAVE_X_WINDOWS */
793 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
794 "Clear face caches on all frames.\n\
795 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
797 Lisp_Object thorougly
;
799 clear_face_cache (!NILP (thorougly
));
805 #ifdef HAVE_X_WINDOWS
808 /* Remove those fonts from the font table of frame F that are not used
809 by fontsets. Called from clear_face_cache from time to time. */
815 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
817 Lisp_Object rest
, frame
;
820 xassert (FRAME_X_P (f
));
822 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
823 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
825 /* For all frames with the same x_display_info as F, record
826 in `used' those fonts that are in use by fontsets. */
827 FOR_EACH_FRAME (rest
, frame
)
828 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
830 struct frame
*f
= XFRAME (frame
);
831 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
833 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
835 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
838 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
840 int idx
= info
->font_indexes
[j
];
847 /* Free those fonts that are not used by fontsets. */
848 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
849 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
851 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
853 /* Free names. In xfns.c there is a comment that full_name
854 should never be freed because it is always shared with
855 something else. I don't think this is true anymore---see
856 x_load_font. It's either equal to font_info->name or
857 allocated via xmalloc, and there seems to be no place in
858 the source files where full_name is transferred to another
860 if (font_info
->full_name
!= font_info
->name
)
861 xfree (font_info
->full_name
);
862 xfree (font_info
->name
);
866 XFreeFont (dpyinfo
->display
, font_info
->font
);
869 /* Mark font table slot free. */
870 font_info
->font
= NULL
;
871 font_info
->name
= font_info
->full_name
= NULL
;
876 #endif /* HAVE_X_WINDOWS */
880 /***********************************************************************
882 ***********************************************************************/
884 #ifdef HAVE_X_WINDOWS
886 DEFUN ("pixmap-spec-p", Fpixmap_spec_p
, Spixmap_spec_p
, 1, 1, 0,
887 "Non-nil if OBJECT is a valid pixmap specification.\n\
888 A pixmap specification is either a string, or a list (WIDTH HEIGHT DATA)\n\
889 where WIDTH is the pixel width of the pixmap, HEIGHT is its height,\n\
890 and DATA contains the bits of the pixmap.")
894 Lisp_Object height
, width
;
896 return ((STRINGP (object
)
898 && CONSP (XCONS (object
)->cdr
)
899 && CONSP (XCONS (XCONS (object
)->cdr
)->cdr
)
900 && NILP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->cdr
)
901 && (width
= XCONS (object
)->car
, INTEGERP (width
))
902 && (height
= XCONS (XCONS (object
)->cdr
)->car
,
904 && STRINGP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)
907 /* The string must have enough bits for width * height. */
908 && ((XSTRING (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)->size
909 * (BITS_PER_INT
/ sizeof (int)))
910 >= XFASTINT (width
) * XFASTINT (height
))))
915 /* Load a bitmap according to NAME (which is either a file name or a
916 pixmap spec) for use on frame F. Value is the bitmap_id (see
917 xfns.c). If NAME is nil, return with a bitmap id of zero. If
918 bitmap cannot be loaded, display a message saying so, and return
919 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
920 if these pointers are not null. */
923 load_pixmap (f
, name
, w_ptr
, h_ptr
)
926 unsigned int *w_ptr
, *h_ptr
;
934 tem
= Fpixmap_spec_p (name
);
936 wrong_type_argument (Qpixmap_spec_p
, name
);
941 /* Decode a bitmap spec into a bitmap. */
946 w
= XINT (Fcar (name
));
947 h
= XINT (Fcar (Fcdr (name
)));
948 bits
= Fcar (Fcdr (Fcdr (name
)));
950 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
955 /* It must be a string -- a file name. */
956 bitmap_id
= x_create_bitmap_from_file (f
, name
);
962 add_to_log (f
, "Invalid or undefined bitmap %s", name
, Qnil
);
973 ++npixmaps_allocated
;
976 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
979 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
985 #endif /* HAVE_X_WINDOWS */
989 /***********************************************************************
991 ***********************************************************************/
993 #ifdef HAVE_X_WINDOWS
995 /* Update the line_height of frame F. Return non-zero if line height
999 frame_update_line_height (f
)
1002 int fontset
, line_height
, changed_p
;
1004 fontset
= f
->output_data
.x
->fontset
;
1006 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
1008 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
1010 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
1011 f
->output_data
.x
->line_height
= line_height
;
1015 #endif /* HAVE_X_WINDOWS */
1018 /***********************************************************************
1020 ***********************************************************************/
1022 #ifdef HAVE_X_WINDOWS
1024 /* Load font or fontset of face FACE which is used on frame F.
1025 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1026 fontset. FONT_NAME is the name of the font to load, if no fontset
1027 is used. It is null if no suitable font name could be determined
1031 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1037 struct font_info
*font_info
= NULL
;
1039 face
->font_info_id
= -1;
1040 face
->fontset
= fontset
;
1045 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1048 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1057 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1058 face
->font
= font_info
->font
;
1059 face
->font_name
= font_info
->full_name
;
1061 /* Make the registry part of the font name readily accessible.
1062 The registry is used to find suitable faces for unibyte text. */
1063 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1065 while (i
< 2 && --s
>= font_info
->full_name
)
1069 if (!STRINGP (face
->registry
)
1070 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1072 if (STRINGP (Vface_default_registry
)
1073 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1074 face
->registry
= Vface_default_registry
;
1076 face
->registry
= build_string (s
+ 1);
1079 else if (fontset
>= 0)
1080 add_to_log (f
, "Unable to load ASCII font of fontset %d",
1081 make_number (fontset
), Qnil
);
1083 add_to_log (f
, "Unable to load font %s",
1084 build_string (font_name
), Qnil
);
1087 #endif /* HAVE_X_WINDOWS */
1091 /***********************************************************************
1093 ***********************************************************************/
1095 #ifdef HAVE_X_WINDOWS
1097 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1098 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1101 face_color_gray_p (f
, color_name
)
1108 if (defined_color (f
, color_name
, &color
, 0))
1109 gray_p
= ((abs (color
.red
- color
.green
)
1110 < max (color
.red
, color
.green
) / 20)
1111 && (abs (color
.green
- color
.blue
)
1112 < max (color
.green
, color
.blue
) / 20)
1113 && (abs (color
.blue
- color
.red
)
1114 < max (color
.blue
, color
.red
) / 20));
1122 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1123 BACKGROUND_P non-zero means the color will be used as background
1127 face_color_supported_p (f
, color_name
, background_p
)
1134 XSETFRAME (frame
, f
);
1135 return (!NILP (Vwindow_system
)
1136 && (!NILP (Fx_display_color_p (frame
))
1137 || xstricmp (color_name
, "black") == 0
1138 || xstricmp (color_name
, "white") == 0
1140 && face_color_gray_p (f
, color_name
))
1141 || (!NILP (Fx_display_grayscale_p (frame
))
1142 && face_color_gray_p (f
, color_name
))));
1146 DEFUN ("face-color-gray-p", Fface_color_gray_p
, Sface_color_gray_p
, 1, 2, 0,
1147 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1148 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1149 If FRAME is nil or omitted, use the selected frame.")
1151 Lisp_Object color
, frame
;
1153 struct frame
*f
= check_x_frame (frame
);
1154 CHECK_STRING (color
, 0);
1155 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1159 DEFUN ("face-color-supported-p", Fface_color_supported_p
,
1160 Sface_color_supported_p
, 2, 3, 0,
1161 "Return non-nil if COLOR can be displayed on FRAME.\n\
1162 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1163 If FRAME is nil or omitted, use the selected frame.\n\
1164 COLOR must be a valid color name.")
1165 (frame
, color
, background_p
)
1166 Lisp_Object frame
, color
, background_p
;
1168 struct frame
*f
= check_x_frame (frame
);
1169 CHECK_STRING (color
, 0);
1170 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1175 /* Load color with name NAME for use by face FACE on frame F.
1176 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1177 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1178 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1179 pixel color. If color cannot be loaded, display a message, and
1180 return the foreground, background or underline color of F, but
1181 record that fact in flags of the face so that we don't try to free
1185 load_color (f
, face
, name
, target_index
)
1189 enum lface_attribute_index target_index
;
1193 xassert (STRINGP (name
));
1194 xassert (target_index
== LFACE_FOREGROUND_INDEX
1195 || target_index
== LFACE_BACKGROUND_INDEX
1196 || target_index
== LFACE_UNDERLINE_INDEX
1197 || target_index
== LFACE_OVERLINE_INDEX
1198 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1199 || target_index
== LFACE_BOX_INDEX
);
1201 /* if the color map is full, defined_color will return a best match
1202 to the values in an existing cell. */
1203 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1205 add_to_log (f
, "Unable to load color %s", name
, Qnil
);
1207 switch (target_index
)
1209 case LFACE_FOREGROUND_INDEX
:
1210 face
->foreground_defaulted_p
= 1;
1211 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1214 case LFACE_BACKGROUND_INDEX
:
1215 face
->background_defaulted_p
= 1;
1216 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1219 case LFACE_UNDERLINE_INDEX
:
1220 face
->underline_defaulted_p
= 1;
1221 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1224 case LFACE_OVERLINE_INDEX
:
1225 face
->overline_color_defaulted_p
= 1;
1226 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1229 case LFACE_STRIKE_THROUGH_INDEX
:
1230 face
->strike_through_color_defaulted_p
= 1;
1231 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1234 case LFACE_BOX_INDEX
:
1235 face
->box_color_defaulted_p
= 1;
1236 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1245 ++ncolors_allocated
;
1252 /* Load colors for face FACE which is used on frame F. Colors are
1253 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1254 of ATTRS. If the background color specified is not supported on F,
1255 try to emulate gray colors with a stipple from Vface_default_stipple. */
1258 load_face_colors (f
, face
, attrs
)
1265 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1266 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1268 /* Swap colors if face is inverse-video. */
1269 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1277 /* Check for support for foreground, not for background because
1278 face_color_supported_p is smart enough to know that grays are
1279 "supported" as background because we are supposed to use stipple
1281 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1282 && !NILP (Fpixmap_spec_p (Vface_default_stipple
)))
1284 x_destroy_bitmap (f
, face
->stipple
);
1285 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1286 &face
->pixmap_w
, &face
->pixmap_h
);
1289 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1290 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1294 /* Free color PIXEL on frame F. */
1297 unload_color (f
, pixel
)
1299 unsigned long pixel
;
1301 Display
*dpy
= FRAME_X_DISPLAY (f
);
1302 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1304 if (pixel
== BLACK_PIX_DEFAULT (f
)
1305 || pixel
== WHITE_PIX_DEFAULT (f
))
1310 /* If display has an immutable color map, freeing colors is not
1311 necessary and some servers don't allow it. So don't do it. */
1312 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1314 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1315 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1322 /* Free colors allocated for FACE. */
1325 free_face_colors (f
, face
)
1329 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1331 /* If display has an immutable color map, freeing colors is not
1332 necessary and some servers don't allow it. So don't do it. */
1333 if (class != StaticColor
1334 && class != StaticGray
1335 && class != TrueColor
)
1341 dpy
= FRAME_X_DISPLAY (f
);
1342 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1344 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1345 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1346 && !face
->foreground_defaulted_p
)
1348 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1349 IF_DEBUG (--ncolors_allocated
);
1352 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1353 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1354 && !face
->background_defaulted_p
)
1356 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1357 IF_DEBUG (--ncolors_allocated
);
1360 if (face
->underline_p
1361 && !face
->underline_defaulted_p
1362 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1363 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1365 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1366 IF_DEBUG (--ncolors_allocated
);
1369 if (face
->overline_p
1370 && !face
->overline_color_defaulted_p
1371 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1372 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1374 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1375 IF_DEBUG (--ncolors_allocated
);
1378 if (face
->strike_through_p
1379 && !face
->strike_through_color_defaulted_p
1380 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1381 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1383 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1384 IF_DEBUG (--ncolors_allocated
);
1387 if (face
->box
!= FACE_NO_BOX
1388 && !face
->box_color_defaulted_p
1389 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1390 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1392 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1393 IF_DEBUG (--ncolors_allocated
);
1400 #else /* ! HAVE_X_WINDOWS */
1404 load_color (f
, face
, name
, target_index
)
1408 enum lface_attribute_index target_index
;
1411 int color_idx
= FACE_TTY_DEFAULT_COLOR
;
1414 return (unsigned long)FACE_TTY_DEFAULT_COLOR
;
1416 CHECK_STRING (name
, 0);
1419 if (XSTRING (name
)->size
&& !NILP (Ffboundp (Qmsdos_color_translate
)))
1421 color
= call1 (Qmsdos_color_translate
, name
);
1423 if (INTEGERP (color
))
1424 return (unsigned long)XINT (color
);
1426 add_to_log (f
, "Unable to load color %s", name
, Qnil
);
1428 switch (target_index
)
1430 case LFACE_FOREGROUND_INDEX
:
1431 face
->foreground_defaulted_p
= 1;
1432 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1435 case LFACE_BACKGROUND_INDEX
:
1436 face
->background_defaulted_p
= 1;
1437 color_idx
= FRAME_BACKGROUND_PIXEL (f
);
1440 case LFACE_UNDERLINE_INDEX
:
1441 face
->underline_defaulted_p
= 1;
1442 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1445 case LFACE_OVERLINE_INDEX
:
1446 face
->overline_color_defaulted_p
= 1;
1447 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1450 case LFACE_STRIKE_THROUGH_INDEX
:
1451 face
->strike_through_color_defaulted_p
= 1;
1452 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1455 case LFACE_BOX_INDEX
:
1456 face
->box_color_defaulted_p
= 1;
1457 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1462 color_idx
= msdos_stdcolor_idx (XSTRING (name
)->data
);
1464 return (unsigned long)color_idx
;
1467 #endif /* ! HAVE_X_WINDOWS */
1471 /***********************************************************************
1473 ***********************************************************************/
1475 /* An enumerator for each field of an XLFD font name. */
1496 /* An enumerator for each possible slant value of a font. Taken from
1497 the XLFD specification. */
1505 XLFD_SLANT_REVERSE_ITALIC
,
1506 XLFD_SLANT_REVERSE_OBLIQUE
,
1510 /* Relative font weight according to XLFD documentation. */
1514 XLFD_WEIGHT_UNKNOWN
,
1515 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1516 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1517 XLFD_WEIGHT_LIGHT
, /* 30 */
1518 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1519 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1520 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1521 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1522 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1523 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1526 /* Relative proportionate width. */
1530 XLFD_SWIDTH_UNKNOWN
,
1531 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1532 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1533 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1534 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1535 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1536 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1537 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1538 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1539 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1542 /* Structure used for tables mapping XLFD weight, slant, and width
1543 names to numeric and symbolic values. */
1549 Lisp_Object
*symbol
;
1552 /* Table of XLFD slant names and their numeric and symbolic
1553 representations. This table must be sorted by slant names in
1556 static struct table_entry slant_table
[] =
1558 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1559 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1560 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1561 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1562 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1563 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1566 /* Table of XLFD weight names. This table must be sorted by weight
1567 names in ascending order. */
1569 static struct table_entry weight_table
[] =
1571 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1572 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1573 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1574 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1575 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1576 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1577 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1578 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1579 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1580 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1581 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1582 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1583 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1584 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1585 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1588 /* Table of XLFD width names. This table must be sorted by width
1589 names in ascending order. */
1591 static struct table_entry swidth_table
[] =
1593 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1594 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1595 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1596 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1597 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1598 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1599 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1600 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1601 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1602 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1603 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1604 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1605 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1606 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1607 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1610 /* Structure used to hold the result of splitting font names in XLFD
1611 format into their fields. */
1615 /* The original name which is modified destructively by
1616 split_font_name. The pointer is kept here to be able to free it
1617 if it was allocated from the heap. */
1620 /* Font name fields. Each vector element points into `name' above.
1621 Fields are NUL-terminated. */
1622 char *fields
[XLFD_LAST
];
1624 /* Numeric values for those fields that interest us. See
1625 split_font_name for which these are. */
1626 int numeric
[XLFD_LAST
];
1629 /* The frame in effect when sorting font names. Set temporarily in
1630 sort_fonts so that it is available in font comparison functions. */
1632 static struct frame
*font_frame
;
1634 /* Order by which font selection chooses fonts. The default values
1635 mean `first, find a best match for the font width, then for the
1636 font height, then for weight, then for slant.' This variable can be
1637 set via set-face-font-sort-order. */
1639 static int font_sort_order
[4];
1642 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1643 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1644 is a pointer to the matching table entry or null if no table entry
1647 static struct table_entry
*
1648 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1649 struct table_entry
*table
;
1651 struct font_name
*font
;
1654 /* Function split_font_name converts fields to lower-case, so there
1655 is no need to use xstrlwr or xstricmp here. */
1656 char *s
= font
->fields
[field_index
];
1657 int low
, mid
, high
, cmp
;
1664 mid
= (low
+ high
) / 2;
1665 cmp
= strcmp (table
[mid
].name
, s
);
1679 /* Return a numeric representation for font name field
1680 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1681 has DIM entries. Value is the numeric value found or DFLT if no
1682 table entry matches. This function is used to translate weight,
1683 slant, and swidth names of XLFD font names to numeric values. */
1686 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1687 struct table_entry
*table
;
1689 struct font_name
*font
;
1693 struct table_entry
*p
;
1694 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1695 return p
? p
->numeric
: dflt
;
1699 /* Return a symbolic representation for font name field
1700 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1701 has DIM entries. Value is the symbolic value found or DFLT if no
1702 table entry matches. This function is used to translate weight,
1703 slant, and swidth names of XLFD font names to symbols. */
1705 static INLINE Lisp_Object
1706 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1707 struct table_entry
*table
;
1709 struct font_name
*font
;
1713 struct table_entry
*p
;
1714 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1715 return p
? *p
->symbol
: dflt
;
1719 /* Return a numeric value for the slant of the font given by FONT. */
1722 xlfd_numeric_slant (font
)
1723 struct font_name
*font
;
1725 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1726 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1730 /* Return a symbol representing the weight of the font given by FONT. */
1732 static INLINE Lisp_Object
1733 xlfd_symbolic_slant (font
)
1734 struct font_name
*font
;
1736 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1737 font
, XLFD_SLANT
, Qnormal
);
1741 /* Return a numeric value for the weight of the font given by FONT. */
1744 xlfd_numeric_weight (font
)
1745 struct font_name
*font
;
1747 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1748 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1752 /* Return a symbol representing the slant of the font given by FONT. */
1754 static INLINE Lisp_Object
1755 xlfd_symbolic_weight (font
)
1756 struct font_name
*font
;
1758 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1759 font
, XLFD_WEIGHT
, Qnormal
);
1763 /* Return a numeric value for the swidth of the font whose XLFD font
1764 name fields are found in FONT. */
1767 xlfd_numeric_swidth (font
)
1768 struct font_name
*font
;
1770 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1771 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1775 /* Return a symbolic value for the swidth of FONT. */
1777 static INLINE Lisp_Object
1778 xlfd_symbolic_swidth (font
)
1779 struct font_name
*font
;
1781 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1782 font
, XLFD_SWIDTH
, Qnormal
);
1786 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1787 entries. Value is a pointer to the matching table entry or null if
1788 no element of TABLE contains SYMBOL. */
1790 static struct table_entry
*
1791 face_value (table
, dim
, symbol
)
1792 struct table_entry
*table
;
1798 xassert (SYMBOLP (symbol
));
1800 for (i
= 0; i
< dim
; ++i
)
1801 if (EQ (*table
[i
].symbol
, symbol
))
1804 return i
< dim
? table
+ i
: NULL
;
1808 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1809 entries. Value is -1 if SYMBOL is not found in TABLE. */
1812 face_numeric_value (table
, dim
, symbol
)
1813 struct table_entry
*table
;
1817 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1818 return p
? p
->numeric
: -1;
1822 /* Return a numeric value representing the weight specified by Lisp
1823 symbol WEIGHT. Value is one of the enumerators of enum
1827 face_numeric_weight (weight
)
1830 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1834 /* Return a numeric value representing the slant specified by Lisp
1835 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1838 face_numeric_slant (slant
)
1841 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1845 /* Return a numeric value representing the swidth specified by Lisp
1846 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1849 face_numeric_swidth (width
)
1852 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1856 #ifdef HAVE_X_WINDOWS
1858 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1862 struct font_name
*font
;
1864 /* Function split_font_name converts fields to lower-case, so there
1865 is no need to use tolower here. */
1866 return *font
->fields
[XLFD_SPACING
] != 'p';
1870 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1872 The actual height of the font when displayed on F depends on the
1873 resolution of both the font and frame. For example, a 10pt font
1874 designed for a 100dpi display will display larger than 10pt on a
1875 75dpi display. (It's not unusual to use fonts not designed for the
1876 display one is using. For example, some intlfonts are available in
1877 72dpi versions, only.)
1879 Value is the real point size of FONT on frame F, or 0 if it cannot
1883 xlfd_point_size (f
, font
)
1885 struct font_name
*font
;
1887 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1888 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1889 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1892 if (font_resy
== 0 || font_pt
== 0)
1895 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1901 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1902 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1903 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1904 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1905 zero if the font name doesn't have the format we expect. The
1906 expected format is a font name that starts with a `-' and has
1907 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1908 forms of font names where certain field contents are enclosed in
1909 square brackets. We don't support that, for now. */
1912 split_font_name (f
, font
, numeric_p
)
1914 struct font_name
*font
;
1920 if (*font
->name
== '-')
1922 char *p
= xstrlwr (font
->name
) + 1;
1924 while (i
< XLFD_LAST
)
1926 font
->fields
[i
] = p
;
1929 while (*p
&& *p
!= '-')
1939 success_p
= i
== XLFD_LAST
;
1941 /* If requested, and font name was in the expected format,
1942 compute numeric values for some fields. */
1943 if (numeric_p
&& success_p
)
1945 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1946 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1947 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1948 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1949 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
1956 /* Build an XLFD font name from font name fields in FONT. Value is a
1957 pointer to the font name, which is allocated via xmalloc. */
1960 build_font_name (font
)
1961 struct font_name
*font
;
1965 char *font_name
= (char *) xmalloc (size
);
1966 int total_length
= 0;
1968 for (i
= 0; i
< XLFD_LAST
; ++i
)
1970 /* Add 1 because of the leading `-'. */
1971 int len
= strlen (font
->fields
[i
]) + 1;
1973 /* Reallocate font_name if necessary. Add 1 for the final
1975 if (total_length
+ len
+ 1 >= size
)
1977 int new_size
= max (2 * size
, size
+ len
+ 1);
1978 int sz
= new_size
* sizeof *font_name
;
1979 font_name
= (char *) xrealloc (font_name
, sz
);
1983 font_name
[total_length
] = '-';
1984 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
1985 total_length
+= len
;
1988 font_name
[total_length
] = 0;
1993 /* Free an array FONTS of N font_name structures. This frees FONTS
1994 itself and all `name' fields in its elements. */
1997 free_font_names (fonts
, n
)
1998 struct font_name
*fonts
;
2002 xfree (fonts
[--n
].name
);
2007 /* Sort vector FONTS of font_name structures which contains NFONTS
2008 elements using qsort and comparison function CMPFN. F is the frame
2009 on which the fonts will be used. The global variable font_frame
2010 is temporarily set to F to make it available in CMPFN. */
2013 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2015 struct font_name
*fonts
;
2017 int (*cmpfn
) P_ ((const void *, const void *));
2020 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2025 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2026 display in x_display_list. FONTS is a pointer to a vector of
2027 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2028 alternative patterns from Valternate_fontname_alist if no fonts are
2029 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2032 For all fonts found, set FONTS[i].name to the name of the font,
2033 allocated via xmalloc, and split font names into fields. Ignore
2034 fonts that we can't parse. Value is the number of fonts found.
2036 This is similar to x_list_fonts. The differences are:
2038 1. It avoids consing.
2039 2. It never calls XLoadQueryFont. */
2042 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2046 struct font_name
*fonts
;
2047 int nfonts
, try_alternatives_p
;
2048 int scalable_fonts_p
;
2050 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2054 /* Get the list of fonts matching PATTERN from the X server. */
2056 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2061 /* Make a copy of the font names we got from X, and
2062 split them into fields. */
2063 for (i
= j
= 0; i
< n
; ++i
)
2065 /* Make a copy of the font name. */
2066 fonts
[j
].name
= xstrdup (names
[i
]);
2068 /* Ignore fonts having a name that we can't parse. */
2069 if (!split_font_name (f
, fonts
+ j
, 1))
2070 xfree (fonts
[j
].name
);
2071 else if (font_scalable_p (fonts
+ j
))
2074 if (!scalable_fonts_p
2075 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2076 xfree (fonts
[j
].name
);
2079 #else /* !SCALABLE_FONTS */
2080 /* Always ignore scalable fonts. */
2081 xfree (fonts
[j
].name
);
2082 #endif /* !SCALABLE_FONTS */
2090 /* Free font names. */
2092 XFreeFontNames (names
);
2097 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2098 if (n
== 0 && try_alternatives_p
)
2100 Lisp_Object list
= Valternate_fontname_alist
;
2102 while (CONSP (list
))
2104 Lisp_Object entry
= XCAR (list
);
2106 && STRINGP (XCAR (entry
))
2107 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2114 Lisp_Object patterns
= XCAR (list
);
2117 while (CONSP (patterns
)
2118 /* If list is screwed up, give up. */
2119 && (name
= XCAR (patterns
),
2121 /* Ignore patterns equal to PATTERN because we tried that
2122 already with no success. */
2123 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2124 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2128 patterns
= XCDR (patterns
);
2136 /* Determine the first font matching PATTERN on frame F. Return in
2137 *FONT the matching font name, split into fields. Value is non-zero
2138 if a match was found. */
2141 first_font_matching (f
, pattern
, font
)
2144 struct font_name
*font
;
2147 struct font_name
*fonts
;
2149 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2150 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2154 bcopy (&fonts
[0], font
, sizeof *font
);
2156 fonts
[0].name
= NULL
;
2157 free_font_names (fonts
, nfonts
);
2164 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2165 using comparison function CMPFN. Value is the number of fonts
2166 found. If value is non-zero, *FONTS is set to a vector of
2167 font_name structures allocated from the heap containing matching
2168 fonts. Each element of *FONTS contains a name member that is also
2169 allocated from the heap. Font names in these structures are split
2170 into fields. Use free_font_names to free such an array. */
2173 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2176 int (*cmpfn
) P_ ((const void *, const void *));
2177 struct font_name
**fonts
;
2181 /* Get the list of fonts matching pattern. 100 should suffice. */
2182 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2183 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2184 nfonts
= XFASTINT (Vfont_list_limit
);
2186 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2188 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2190 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2193 /* Sort the resulting array and return it in *FONTS. If no
2194 fonts were found, make sure to set *FONTS to null. */
2196 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2207 /* Compare two font_name structures *A and *B. Value is analogous to
2208 strcmp. Sort order is given by the global variable
2209 font_sort_order. Font names are sorted so that, everything else
2210 being equal, fonts with a resolution closer to that of the frame on
2211 which they are used are listed first. The global variable
2212 font_frame is the frame on which we operate. */
2215 cmp_font_names (a
, b
)
2218 struct font_name
*x
= (struct font_name
*) a
;
2219 struct font_name
*y
= (struct font_name
*) b
;
2222 /* All strings have been converted to lower-case by split_font_name,
2223 so we can use strcmp here. */
2224 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2229 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2231 int j
= font_sort_order
[i
];
2232 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2237 /* Everything else being equal, we prefer fonts with an
2238 y-resolution closer to that of the frame. */
2239 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2240 int x_resy
= x
->numeric
[XLFD_RESY
];
2241 int y_resy
= y
->numeric
[XLFD_RESY
];
2242 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2250 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2251 is non-null list fonts matching that pattern. Otherwise, if
2252 REGISTRY_AND_ENCODING is non-null return only fonts with that
2253 registry and encoding, otherwise return fonts of any registry and
2254 encoding. Set *FONTS to a vector of font_name structures allocated
2255 from the heap containing the fonts found. Value is the number of
2259 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2263 char *registry_and_encoding
;
2264 struct font_name
**fonts
;
2266 if (pattern
== NULL
)
2271 if (registry_and_encoding
== NULL
)
2272 registry_and_encoding
= "*";
2274 pattern
= (char *) alloca (strlen (family
)
2275 + strlen (registry_and_encoding
)
2277 if (index (family
, '-'))
2278 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2280 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2283 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2287 /* Remove elements from LIST whose cars are `equal'. Called from
2288 x-family-fonts and x-font-family-list to remove duplicate font
2292 remove_duplicates (list
)
2295 Lisp_Object tail
= list
;
2297 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2299 Lisp_Object next
= XCDR (tail
);
2300 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2301 XCDR (tail
) = XCDR (next
);
2308 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2309 "Return a list of available fonts of family FAMILY on FRAME.\n\
2310 If FAMILY is omitted or nil, list all families.\n\
2311 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2313 If FRAME is omitted or nil, use the selected frame.\n\
2314 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2315 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2316 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2317 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2318 width, weight and slant of the font. These symbols are the same as for\n\
2319 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2320 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2321 giving the registry and encoding of the font.\n\
2322 The result list is sorted according to the current setting of\n\
2323 the face font sort order.")
2325 Lisp_Object family
, frame
;
2327 struct frame
*f
= check_x_frame (frame
);
2328 struct font_name
*fonts
;
2331 struct gcpro gcpro1
;
2332 char *family_pattern
;
2335 family_pattern
= "*";
2338 CHECK_STRING (family
, 1);
2339 family_pattern
= LSTRDUPA (family
);
2344 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2345 for (i
= nfonts
- 1; i
>= 0; --i
)
2347 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2350 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2352 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2353 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2354 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2355 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2356 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2357 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2358 tem
= build_font_name (fonts
+ i
);
2359 ASET (v
, 6, build_string (tem
));
2360 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2361 fonts
[i
].fields
[XLFD_ENCODING
]);
2362 ASET (v
, 7, build_string (tem
));
2365 result
= Fcons (v
, result
);
2370 remove_duplicates (result
);
2371 free_font_names (fonts
, nfonts
);
2377 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2379 "Return a list of available font families on FRAME.\n\
2380 If FRAME is omitted or nil, use the selected frame.\n\
2381 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2382 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2387 struct frame
*f
= check_x_frame (frame
);
2389 struct font_name
*fonts
;
2391 struct gcpro gcpro1
;
2392 int count
= specpdl_ptr
- specpdl
;
2395 /* Let's consider all fonts. Increase the limit for matching
2396 fonts until we have them all. */
2399 specbind (intern ("font-list-limit"), make_number (limit
));
2400 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2402 if (nfonts
== limit
)
2404 free_font_names (fonts
, nfonts
);
2413 for (i
= nfonts
- 1; i
>= 0; --i
)
2414 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2415 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2418 remove_duplicates (result
);
2419 free_font_names (fonts
, nfonts
);
2421 return unbind_to (count
, result
);
2425 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2426 "Return a list of the names of available fonts matching PATTERN.\n\
2427 If optional arguments FACE and FRAME are specified, return only fonts\n\
2428 the same size as FACE on FRAME.\n\
2429 PATTERN is a string, perhaps with wildcard characters;\n\
2430 the * character matches any substring, and\n\
2431 the ? character matches any single character.\n\
2432 PATTERN is case-insensitive.\n\
2433 FACE is a face name--a symbol.\n\
2435 The return value is a list of strings, suitable as arguments to\n\
2438 Fonts Emacs can't use may or may not be excluded\n\
2439 even if they match PATTERN and FACE.\n\
2440 The optional fourth argument MAXIMUM sets a limit on how many\n\
2441 fonts to match. The first MAXIMUM fonts are reported.\n\
2442 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2443 occupied by a character of a font. In that case, return only fonts\n\
2444 the WIDTH times as wide as FACE on FRAME.")
2445 (pattern
, face
, frame
, maximum
, width
)
2446 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2453 CHECK_STRING (pattern
, 0);
2459 CHECK_NATNUM (maximum
, 0);
2460 maxnames
= XINT (maximum
);
2464 CHECK_NUMBER (width
, 4);
2466 /* We can't simply call check_x_frame because this function may be
2467 called before any frame is created. */
2468 f
= frame_or_selected_frame (frame
, 2);
2471 /* Perhaps we have not yet created any frame. */
2476 /* Determine the width standard for comparison with the fonts we find. */
2482 /* This is of limited utility since it works with character
2483 widths. Keep it for compatibility. --gerd. */
2484 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2485 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2488 size
= face
->font
->max_bounds
.width
;
2490 size
= FRAME_FONT (f
)->max_bounds
.width
;
2493 size
*= XINT (width
);
2497 Lisp_Object args
[2];
2499 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2501 /* We don't have to check fontsets. */
2503 args
[1] = list_fontsets (f
, pattern
, size
);
2504 return Fnconc (2, args
);
2508 #endif /* HAVE_X_WINDOWS */
2512 /***********************************************************************
2514 ***********************************************************************/
2516 /* Access face attributes of face FACE, a Lisp vector. */
2518 #define LFACE_FAMILY(LFACE) \
2519 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2520 #define LFACE_HEIGHT(LFACE) \
2521 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2522 #define LFACE_WEIGHT(LFACE) \
2523 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2524 #define LFACE_SLANT(LFACE) \
2525 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2526 #define LFACE_UNDERLINE(LFACE) \
2527 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2528 #define LFACE_INVERSE(LFACE) \
2529 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2530 #define LFACE_FOREGROUND(LFACE) \
2531 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2532 #define LFACE_BACKGROUND(LFACE) \
2533 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2534 #define LFACE_STIPPLE(LFACE) \
2535 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2536 #define LFACE_SWIDTH(LFACE) \
2537 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2538 #define LFACE_OVERLINE(LFACE) \
2539 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2540 #define LFACE_STRIKE_THROUGH(LFACE) \
2541 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2542 #define LFACE_BOX(LFACE) \
2543 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2545 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2546 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2548 #define LFACEP(LFACE) \
2550 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2551 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2556 /* Check consistency of Lisp face attribute vector ATTRS. */
2559 check_lface_attrs (attrs
)
2562 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2563 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2564 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2565 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2566 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2567 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2568 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2569 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2570 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2571 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2572 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2573 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2574 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2575 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2576 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2577 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2578 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2579 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2580 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2581 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2582 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2583 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2584 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2585 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2586 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2587 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2588 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2589 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2590 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2591 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2592 #ifdef HAVE_WINDOW_SYSTEM
2593 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2594 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2595 || !NILP (Fpixmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2600 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2608 xassert (LFACEP (lface
));
2609 check_lface_attrs (XVECTOR (lface
)->contents
);
2613 #else /* GLYPH_DEBUG == 0 */
2615 #define check_lface_attrs(attrs) (void) 0
2616 #define check_lface(lface) (void) 0
2618 #endif /* GLYPH_DEBUG == 0 */
2621 /* Return the face definition of FACE_NAME on frame F. F null means
2622 return the global definition. FACE_NAME may be a string or a
2623 symbol (apparently Emacs 20.2 allows strings as face names in face
2624 text properties; ediff uses that). If FACE_NAME is an alias for
2625 another face, return that face's definition. If SIGNAL_P is
2626 non-zero, signal an error if FACE_NAME is not a valid face name.
2627 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2630 static INLINE Lisp_Object
2631 lface_from_face_name (f
, face_name
, signal_p
)
2633 Lisp_Object face_name
;
2636 Lisp_Object lface
, alias
;
2638 if (STRINGP (face_name
))
2639 face_name
= intern (XSTRING (face_name
)->data
);
2641 /* If FACE_NAME is an alias for another face, return the definition
2642 of the aliased face. */
2643 alias
= Fget (face_name
, Qface_alias
);
2648 lface
= assq_no_quit (face_name
, f
->face_alist
);
2650 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2653 lface
= XCDR (lface
);
2655 signal_error ("Invalid face", face_name
);
2657 check_lface (lface
);
2662 /* Get face attributes of face FACE_NAME from frame-local faces on
2663 frame F. Store the resulting attributes in ATTRS which must point
2664 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2665 is non-zero, signal an error if FACE_NAME does not name a face.
2666 Otherwise, value is zero if FACE_NAME is not a face. */
2669 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2671 Lisp_Object face_name
;
2678 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2681 bcopy (XVECTOR (lface
)->contents
, attrs
,
2682 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2692 /* Non-zero if all attributes in face attribute vector ATTRS are
2693 specified, i.e. are non-nil. */
2696 lface_fully_specified_p (attrs
)
2701 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2702 if (UNSPECIFIEDP (attrs
[i
]))
2705 return i
== LFACE_VECTOR_SIZE
;
2709 #ifdef HAVE_X_WINDOWS
2711 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2712 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2713 LFACE. Ignore fields of FONT_NAME containing wildcards. Value is
2714 zero if not successful because FONT_NAME was not in a valid format.
2715 A valid format is one that is suitable for split_font_name, see the
2719 set_lface_from_font_name (f
, lface
, font_name
, force_p
)
2725 struct font_name font
;
2728 int free_font_name_p
= 0;
2730 /* If FONT_NAME contains wildcards, use the first matching font. */
2731 if (index (font_name
, '*') || index (font_name
, '?'))
2733 if (!first_font_matching (f
, font_name
, &font
))
2735 free_font_name_p
= 1;
2739 font
.name
= STRDUPA (font_name
);
2740 if (!split_font_name (f
, &font
, 1))
2742 /* The font name may be something like `6x13'. Make
2743 sure we use the full name. */
2744 struct font_info
*font_info
;
2747 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2748 CHARSET_ASCII
, font_name
, -1);
2754 font
.name
= STRDUPA (font_info
->full_name
);
2755 split_font_name (f
, &font
, 1);
2758 /* FONT_NAME should not be a fontset name, here. */
2759 xassert (xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0);
2762 /* Set attributes only if unspecified, otherwise face defaults for
2763 new frames would never take effect. */
2765 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2767 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2768 + strlen (font
.fields
[XLFD_FOUNDRY
])
2770 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2771 font
.fields
[XLFD_FAMILY
]);
2772 LFACE_FAMILY (lface
) = build_string (buffer
);
2775 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2777 pt
= xlfd_point_size (f
, &font
);
2779 LFACE_HEIGHT (lface
) = make_number (pt
);
2782 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2783 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2785 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2786 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2788 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2789 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2791 if (free_font_name_p
)
2797 #endif /* HAVE_X_WINDOWS */
2800 /* Merge two Lisp face attribute vectors FROM and TO and store the
2801 resulting attributes in TO. Every non-nil attribute of FROM
2802 overrides the corresponding attribute of TO. */
2805 merge_face_vectors (from
, to
)
2806 Lisp_Object
*from
, *to
;
2809 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2810 if (!UNSPECIFIEDP (from
[i
]))
2815 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2816 is a face property, determine the resulting face attributes on
2817 frame F, and store them in TO. PROP may be a single face
2818 specification or a list of such specifications. Each face
2819 specification can be
2821 1. A symbol or string naming a Lisp face.
2823 2. A property list of the form (KEYWORD VALUE ...) where each
2824 KEYWORD is a face attribute name, and value is an appropriate value
2827 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2828 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2829 for compatibility with 20.2.
2831 Face specifications earlier in lists take precedence over later
2835 merge_face_vector_with_property (f
, to
, prop
)
2842 Lisp_Object first
= XCAR (prop
);
2844 if (EQ (first
, Qforeground_color
)
2845 || EQ (first
, Qbackground_color
))
2847 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2848 . COLOR). COLOR must be a string. */
2849 Lisp_Object color_name
= XCDR (prop
);
2850 Lisp_Object color
= first
;
2852 if (STRINGP (color_name
))
2854 if (EQ (color
, Qforeground_color
))
2855 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2857 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2860 add_to_log (f
, "Invalid face color", color_name
, Qnil
);
2862 else if (SYMBOLP (first
)
2863 && *XSYMBOL (first
)->name
->data
== ':')
2865 /* Assume this is the property list form. */
2866 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2868 Lisp_Object keyword
= XCAR (prop
);
2869 Lisp_Object value
= XCAR (XCDR (prop
));
2871 if (EQ (keyword
, QCfamily
))
2873 if (STRINGP (value
))
2874 to
[LFACE_FAMILY_INDEX
] = value
;
2876 add_to_log (f
, "Illegal face font family", value
, Qnil
);
2878 else if (EQ (keyword
, QCheight
))
2880 if (INTEGERP (value
))
2881 to
[LFACE_HEIGHT_INDEX
] = value
;
2883 add_to_log (f
, "Illegal face font height", value
, Qnil
);
2885 else if (EQ (keyword
, QCweight
))
2888 && face_numeric_weight (value
) >= 0)
2889 to
[LFACE_WEIGHT_INDEX
] = value
;
2891 add_to_log (f
, "Illegal face weight", value
, Qnil
);
2893 else if (EQ (keyword
, QCslant
))
2896 && face_numeric_slant (value
) >= 0)
2897 to
[LFACE_SLANT_INDEX
] = value
;
2899 add_to_log (f
, "Illegal face slant", value
, Qnil
);
2901 else if (EQ (keyword
, QCunderline
))
2906 to
[LFACE_UNDERLINE_INDEX
] = value
;
2908 add_to_log (f
, "Illegal face underline", value
, Qnil
);
2910 else if (EQ (keyword
, QCoverline
))
2915 to
[LFACE_OVERLINE_INDEX
] = value
;
2917 add_to_log (f
, "Illegal face overline", value
, Qnil
);
2919 else if (EQ (keyword
, QCstrike_through
))
2924 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2926 add_to_log (f
, "Illegal face strike-through", value
, Qnil
);
2928 else if (EQ (keyword
, QCbox
))
2931 value
= make_number (1);
2932 if (INTEGERP (value
)
2936 to
[LFACE_BOX_INDEX
] = value
;
2938 add_to_log (f
, "Illegal face box", value
, Qnil
);
2940 else if (EQ (keyword
, QCinverse_video
)
2941 || EQ (keyword
, QCreverse_video
))
2943 if (EQ (value
, Qt
) || NILP (value
))
2944 to
[LFACE_INVERSE_INDEX
] = value
;
2946 add_to_log (f
, "Illegal face inverse-video", value
, Qnil
);
2948 else if (EQ (keyword
, QCforeground
))
2950 if (STRINGP (value
))
2951 to
[LFACE_FOREGROUND_INDEX
] = value
;
2953 add_to_log (f
, "Illegal face foreground", value
, Qnil
);
2955 else if (EQ (keyword
, QCbackground
))
2957 if (STRINGP (value
))
2958 to
[LFACE_BACKGROUND_INDEX
] = value
;
2960 add_to_log (f
, "Illegal face background", value
, Qnil
);
2962 else if (EQ (keyword
, QCstipple
))
2964 #ifdef HAVE_X_WINDOWS
2965 Lisp_Object pixmap_p
= Fpixmap_spec_p (value
);
2966 if (!NILP (pixmap_p
))
2967 to
[LFACE_STIPPLE_INDEX
] = value
;
2969 add_to_log (f
, "Illegal face stipple", value
, Qnil
);
2972 else if (EQ (keyword
, QCwidth
))
2975 && face_numeric_swidth (value
) >= 0)
2976 to
[LFACE_SWIDTH_INDEX
] = value
;
2978 add_to_log (f
, "Illegal face width", value
, Qnil
);
2981 add_to_log (f
, "Invalid attribute %s in face property",
2984 prop
= XCDR (XCDR (prop
));
2989 /* This is a list of face specs. Specifications at the
2990 beginning of the list take precedence over later
2991 specifications, so we have to merge starting with the
2992 last specification. */
2993 Lisp_Object next
= XCDR (prop
);
2995 merge_face_vector_with_property (f
, to
, next
);
2996 merge_face_vector_with_property (f
, to
, first
);
3001 /* PROP ought to be a face name. */
3002 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3004 add_to_log (f
, "Invalid face text property value: %s", prop
, Qnil
);
3006 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3011 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3012 Sinternal_make_lisp_face
, 1, 2, 0,
3013 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3014 If FACE was not known as a face before, create a new one.\n\
3015 If optional argument FRAME is specified, make a frame-local face\n\
3016 for that frame. Otherwise operate on the global face definition.\n\
3017 Value is a vector of face attributes.")
3019 Lisp_Object face
, frame
;
3021 Lisp_Object global_lface
, lface
;
3025 CHECK_SYMBOL (face
, 0);
3026 global_lface
= lface_from_face_name (NULL
, face
, 0);
3030 CHECK_LIVE_FRAME (frame
, 1);
3032 lface
= lface_from_face_name (f
, face
, 0);
3035 f
= NULL
, lface
= Qnil
;
3037 /* Add a global definition if there is none. */
3038 if (NILP (global_lface
))
3040 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3042 XVECTOR (global_lface
)->contents
[0] = Qface
;
3043 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3044 Vface_new_frame_defaults
);
3046 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3047 face id to Lisp face is given by the vector lface_id_to_name.
3048 The mapping from Lisp face to Lisp face id is given by the
3049 property `face' of the Lisp face name. */
3050 if (next_lface_id
== lface_id_to_name_size
)
3052 int new_size
= max (50, 2 * lface_id_to_name_size
);
3053 int sz
= new_size
* sizeof *lface_id_to_name
;
3054 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3055 lface_id_to_name_size
= new_size
;
3058 lface_id_to_name
[next_lface_id
] = face
;
3059 Fput (face
, Qface
, make_number (next_lface_id
));
3063 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3064 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3066 /* Add a frame-local definition. */
3071 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3073 XVECTOR (lface
)->contents
[0] = Qface
;
3074 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3077 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3078 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3081 lface
= global_lface
;
3083 xassert (LFACEP (lface
));
3084 check_lface (lface
);
3089 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3090 Sinternal_lisp_face_p
, 1, 2, 0,
3091 "Return non-nil if FACE names a face.\n\
3092 If optional second parameter FRAME is non-nil, check for the\n\
3093 existence of a frame-local face with name FACE on that frame.\n\
3094 Otherwise check for the existence of a global face.")
3096 Lisp_Object face
, frame
;
3102 CHECK_LIVE_FRAME (frame
, 1);
3103 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3106 lface
= lface_from_face_name (NULL
, face
, 0);
3112 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3113 Sinternal_copy_lisp_face
, 4, 4, 0,
3114 "Copy face FROM to TO.\n\
3115 If FRAME it t, copy the global face definition of FROM to the\n\
3116 global face definition of TO. Otherwise, copy the frame-local\n\
3117 definition of FROM on FRAME to the frame-local definition of TO\n\
3118 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3121 (from
, to
, frame
, new_frame
)
3122 Lisp_Object from
, to
, frame
, new_frame
;
3124 Lisp_Object lface
, copy
;
3126 CHECK_SYMBOL (from
, 0);
3127 CHECK_SYMBOL (to
, 1);
3128 if (NILP (new_frame
))
3133 /* Copy global definition of FROM. We don't make copies of
3134 strings etc. because 20.2 didn't do it either. */
3135 lface
= lface_from_face_name (NULL
, from
, 1);
3136 copy
= Finternal_make_lisp_face (to
, Qnil
);
3140 /* Copy frame-local definition of FROM. */
3141 CHECK_LIVE_FRAME (frame
, 2);
3142 CHECK_LIVE_FRAME (new_frame
, 3);
3143 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3144 copy
= Finternal_make_lisp_face (to
, new_frame
);
3147 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3148 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3154 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3155 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3156 "Set attribute ATTR of FACE to VALUE.\n\
3157 If optional argument FRAME is given, set the face attribute of face FACE\n\
3158 on that frame. If FRAME is t, set the attribute of the default for face\n\
3159 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3161 (face
, attr
, value
, frame
)
3162 Lisp_Object face
, attr
, value
, frame
;
3165 Lisp_Object old_value
= Qnil
;
3166 int font_related_attr_p
= 0;
3168 CHECK_SYMBOL (face
, 0);
3169 CHECK_SYMBOL (attr
, 1);
3171 /* Set lface to the Lisp attribute vector of FACE. */
3173 lface
= lface_from_face_name (NULL
, face
, 1);
3177 XSETFRAME (frame
, selected_frame
);
3179 CHECK_LIVE_FRAME (frame
, 3);
3180 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3182 /* If a frame-local face doesn't exist yet, create one. */
3184 lface
= Finternal_make_lisp_face (face
, frame
);
3187 if (EQ (attr
, QCfamily
))
3189 if (!UNSPECIFIEDP (value
))
3191 CHECK_STRING (value
, 3);
3192 if (XSTRING (value
)->size
== 0)
3193 signal_error ("Invalid face family", value
);
3195 old_value
= LFACE_FAMILY (lface
);
3196 LFACE_FAMILY (lface
) = value
;
3197 font_related_attr_p
= 1;
3199 else if (EQ (attr
, QCheight
))
3201 if (!UNSPECIFIEDP (value
))
3203 CHECK_NUMBER (value
, 3);
3204 if (XINT (value
) <= 0)
3205 signal_error ("Invalid face height", value
);
3207 old_value
= LFACE_HEIGHT (lface
);
3208 LFACE_HEIGHT (lface
) = value
;
3209 font_related_attr_p
= 1;
3211 else if (EQ (attr
, QCweight
))
3213 if (!UNSPECIFIEDP (value
))
3215 CHECK_SYMBOL (value
, 3);
3216 if (face_numeric_weight (value
) < 0)
3217 signal_error ("Invalid face weight", value
);
3219 old_value
= LFACE_WEIGHT (lface
);
3220 LFACE_WEIGHT (lface
) = value
;
3221 font_related_attr_p
= 1;
3223 else if (EQ (attr
, QCslant
))
3225 if (!UNSPECIFIEDP (value
))
3227 CHECK_SYMBOL (value
, 3);
3228 if (face_numeric_slant (value
) < 0)
3229 signal_error ("Invalid face slant", value
);
3231 old_value
= LFACE_SLANT (lface
);
3232 LFACE_SLANT (lface
) = value
;
3233 font_related_attr_p
= 1;
3235 else if (EQ (attr
, QCunderline
))
3237 if (!UNSPECIFIEDP (value
))
3238 if ((SYMBOLP (value
)
3240 && !EQ (value
, Qnil
))
3241 /* Underline color. */
3243 && XSTRING (value
)->size
== 0))
3244 signal_error ("Invalid face underline", value
);
3246 old_value
= LFACE_UNDERLINE (lface
);
3247 LFACE_UNDERLINE (lface
) = value
;
3249 else if (EQ (attr
, QCoverline
))
3251 if (!UNSPECIFIEDP (value
))
3252 if ((SYMBOLP (value
)
3254 && !EQ (value
, Qnil
))
3255 /* Overline color. */
3257 && XSTRING (value
)->size
== 0))
3258 signal_error ("Invalid face overline", value
);
3260 old_value
= LFACE_OVERLINE (lface
);
3261 LFACE_OVERLINE (lface
) = value
;
3263 else if (EQ (attr
, QCstrike_through
))
3265 if (!UNSPECIFIEDP (value
))
3266 if ((SYMBOLP (value
)
3268 && !EQ (value
, Qnil
))
3269 /* Strike-through color. */
3271 && XSTRING (value
)->size
== 0))
3272 signal_error ("Invalid face strike-through", value
);
3274 old_value
= LFACE_STRIKE_THROUGH (lface
);
3275 LFACE_STRIKE_THROUGH (lface
) = value
;
3277 else if (EQ (attr
, QCbox
))
3281 /* Allow t meaning a simple box of width 1 in foreground color
3284 value
= make_number (1);
3286 if (UNSPECIFIEDP (value
))
3288 else if (NILP (value
))
3290 else if (INTEGERP (value
))
3291 valid_p
= XINT (value
) > 0;
3292 else if (STRINGP (value
))
3293 valid_p
= XSTRING (value
)->size
> 0;
3294 else if (CONSP (value
))
3310 if (EQ (k
, QCline_width
))
3312 if (!INTEGERP (v
) || XINT (v
) <= 0)
3315 else if (EQ (k
, QCcolor
))
3317 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3320 else if (EQ (k
, QCstyle
))
3322 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3329 valid_p
= NILP (tem
);
3335 signal_error ("Invalid face box", value
);
3337 old_value
= LFACE_BOX (lface
);
3338 LFACE_BOX (lface
) = value
;
3340 else if (EQ (attr
, QCinverse_video
)
3341 || EQ (attr
, QCreverse_video
))
3343 if (!UNSPECIFIEDP (value
))
3345 CHECK_SYMBOL (value
, 3);
3346 if (!EQ (value
, Qt
) && !NILP (value
))
3347 signal_error ("Invalid inverse-video face attribute value", value
);
3349 old_value
= LFACE_INVERSE (lface
);
3350 LFACE_INVERSE (lface
) = value
;
3352 else if (EQ (attr
, QCforeground
))
3354 if (!UNSPECIFIEDP (value
))
3356 /* Don't check for valid color names here because it depends
3357 on the frame (display) whether the color will be valid
3358 when the face is realized. */
3359 CHECK_STRING (value
, 3);
3360 if (XSTRING (value
)->size
== 0)
3361 signal_error ("Empty foreground color value", value
);
3363 old_value
= LFACE_FOREGROUND (lface
);
3364 LFACE_FOREGROUND (lface
) = value
;
3366 else if (EQ (attr
, QCbackground
))
3368 if (!UNSPECIFIEDP (value
))
3370 /* Don't check for valid color names here because it depends
3371 on the frame (display) whether the color will be valid
3372 when the face is realized. */
3373 CHECK_STRING (value
, 3);
3374 if (XSTRING (value
)->size
== 0)
3375 signal_error ("Empty background color value", value
);
3377 old_value
= LFACE_BACKGROUND (lface
);
3378 LFACE_BACKGROUND (lface
) = value
;
3380 else if (EQ (attr
, QCstipple
))
3382 #ifdef HAVE_X_WINDOWS
3383 if (!UNSPECIFIEDP (value
)
3385 && NILP (Fpixmap_spec_p (value
)))
3386 signal_error ("Invalid stipple attribute", value
);
3387 old_value
= LFACE_STIPPLE (lface
);
3388 LFACE_STIPPLE (lface
) = value
;
3389 #endif /* HAVE_X_WINDOWS */
3391 else if (EQ (attr
, QCwidth
))
3393 if (!UNSPECIFIEDP (value
))
3395 CHECK_SYMBOL (value
, 3);
3396 if (face_numeric_swidth (value
) < 0)
3397 signal_error ("Invalid face width", value
);
3399 old_value
= LFACE_SWIDTH (lface
);
3400 LFACE_SWIDTH (lface
) = value
;
3401 font_related_attr_p
= 1;
3403 else if (EQ (attr
, QCfont
))
3405 #ifdef HAVE_X_WINDOWS
3406 /* Set font-related attributes of the Lisp face from an
3410 CHECK_STRING (value
, 3);
3414 f
= check_x_frame (frame
);
3416 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1))
3417 signal_error ("Invalid font name", value
);
3419 font_related_attr_p
= 1;
3420 #endif /* HAVE_X_WINDOWS */
3422 else if (EQ (attr
, QCbold
))
3424 old_value
= LFACE_WEIGHT (lface
);
3425 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3426 font_related_attr_p
= 1;
3428 else if (EQ (attr
, QCitalic
))
3430 old_value
= LFACE_SLANT (lface
);
3431 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3432 font_related_attr_p
= 1;
3435 signal_error ("Invalid face attribute name", attr
);
3437 /* Changing a named face means that all realized faces depending on
3438 that face are invalid. Since we cannot tell which realized faces
3439 depend on the face, make sure they are all removed. This is done
3440 by incrementing face_change_count. The next call to
3441 init_iterator will then free realized faces. */
3443 && (EQ (attr
, QCfont
)
3444 || NILP (Fequal (old_value
, value
))))
3446 ++face_change_count
;
3447 ++windows_or_buffers_changed
;
3450 #ifdef HAVE_X_WINDOWS
3453 && !UNSPECIFIEDP (value
)
3454 && NILP (Fequal (old_value
, value
)))
3460 if (EQ (face
, Qdefault
))
3462 /* Changed font-related attributes of the `default' face are
3463 reflected in changed `font' frame parameters. */
3464 if (font_related_attr_p
3465 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3466 set_font_frame_param (frame
, lface
);
3467 else if (EQ (attr
, QCforeground
))
3468 param
= Qforeground_color
;
3469 else if (EQ (attr
, QCbackground
))
3470 param
= Qbackground_color
;
3472 else if (EQ (face
, Qscroll_bar
))
3474 /* Changing the colors of `scroll-bar' sets frame parameters
3475 `scroll-bar-foreground' and `scroll-bar-background'. */
3476 if (EQ (attr
, QCforeground
))
3477 param
= Qscroll_bar_foreground
;
3478 else if (EQ (attr
, QCbackground
))
3479 param
= Qscroll_bar_background
;
3481 else if (EQ (face
, Qborder
))
3483 /* Changing background color of `border' sets frame parameter
3485 if (EQ (attr
, QCbackground
))
3486 param
= Qborder_color
;
3488 else if (EQ (face
, Qcursor
))
3490 /* Changing background color of `cursor' sets frame parameter
3492 if (EQ (attr
, QCbackground
))
3493 param
= Qcursor_color
;
3495 else if (EQ (face
, Qmouse
))
3497 /* Changing background color of `mouse' sets frame parameter
3499 if (EQ (attr
, QCbackground
))
3500 param
= Qmouse_color
;
3503 if (SYMBOLP (param
))
3504 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3507 #endif /* HAVE_X_WINDOWS */
3513 #ifdef HAVE_X_WINDOWS
3515 /* Set the `font' frame parameter of FRAME according to `default' face
3516 attributes LFACE. */
3519 set_font_frame_param (frame
, lface
)
3520 Lisp_Object frame
, lface
;
3522 struct frame
*f
= XFRAME (frame
);
3523 Lisp_Object frame_font
;
3527 /* Get FRAME's font parameter. */
3528 frame_font
= Fassq (Qfont
, f
->param_alist
);
3529 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3530 frame_font
= XCDR (frame_font
);
3532 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3535 /* Frame parameter is a fontset name. Modify the fontset so
3536 that all its fonts reflect face attributes LFACE. */
3538 struct fontset_info
*fontset_info
;
3540 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3542 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3543 if (fontset_info
->fontname
[charset
])
3545 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3547 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3548 build_string (font
), frame
);
3554 /* Frame parameter is an X font name. I believe this can
3555 only happen in unibyte mode. */
3556 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3557 -1, Vface_default_registry
);
3560 store_frame_param (f
, Qfont
, build_string (font
));
3567 /* Update the corresponding face when frame parameter PARAM on frame F
3568 has been assigned the value NEW_VALUE. */
3571 update_face_from_frame_parameter (f
, param
, new_value
)
3573 Lisp_Object param
, new_value
;
3577 /* If there are no faces yet, give up. This is the case when called
3578 from Fx_create_frame, and we do the necessary things later in
3579 face-set-after-frame-defaults. */
3580 if (NILP (f
->face_alist
))
3583 if (EQ (param
, Qforeground_color
))
3585 lface
= lface_from_face_name (f
, Qdefault
, 1);
3586 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3587 ? new_value
: Qunspecified
);
3588 realize_basic_faces (f
);
3590 else if (EQ (param
, Qbackground_color
))
3594 /* Changing the background color might change the background
3595 mode, so that we have to load new defface specs. Call
3596 frame-update-face-colors to do that. */
3597 XSETFRAME (frame
, f
);
3598 call1 (Qframe_update_face_colors
, frame
);
3600 lface
= lface_from_face_name (f
, Qdefault
, 1);
3601 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3602 ? new_value
: Qunspecified
);
3603 realize_basic_faces (f
);
3605 if (EQ (param
, Qborder_color
))
3607 lface
= lface_from_face_name (f
, Qborder
, 1);
3608 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3609 ? new_value
: Qunspecified
);
3611 else if (EQ (param
, Qcursor_color
))
3613 lface
= lface_from_face_name (f
, Qcursor
, 1);
3614 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3615 ? new_value
: Qunspecified
);
3617 else if (EQ (param
, Qmouse_color
))
3619 lface
= lface_from_face_name (f
, Qmouse
, 1);
3620 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3621 ? new_value
: Qunspecified
);
3626 /* Get the value of X resource RESOURCE, class CLASS for the display
3627 of frame FRAME. This is here because ordinary `x-get-resource'
3628 doesn't take a frame argument. */
3630 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3631 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3632 (resource
, class, frame
)
3633 Lisp_Object resource
, class, frame
;
3636 CHECK_STRING (resource
, 0);
3637 CHECK_STRING (class, 1);
3638 CHECK_LIVE_FRAME (frame
, 2);
3640 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3641 resource
, class, Qnil
, Qnil
);
3647 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3648 If VALUE is "on" or "true", return t. If VALUE is "off" or
3649 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3650 error; if SIGNAL_P is zero, return 0. */
3653 face_boolean_x_resource_value (value
, signal_p
)
3657 Lisp_Object result
= make_number (0);
3659 xassert (STRINGP (value
));
3661 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3662 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3664 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3665 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3667 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3668 result
= Qunspecified
;
3670 signal_error ("Invalid face attribute value from X resource", value
);
3676 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3677 Finternal_set_lisp_face_attribute_from_resource
,
3678 Sinternal_set_lisp_face_attribute_from_resource
,
3680 (face
, attr
, value
, frame
)
3681 Lisp_Object face
, attr
, value
, frame
;
3683 CHECK_SYMBOL (face
, 0);
3684 CHECK_SYMBOL (attr
, 1);
3685 CHECK_STRING (value
, 2);
3687 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3688 value
= Qunspecified
;
3689 else if (EQ (attr
, QCheight
))
3691 value
= Fstring_to_number (value
, make_number (10));
3692 if (XINT (value
) <= 0)
3693 signal_error ("Invalid face height from X resource", value
);
3695 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3696 value
= face_boolean_x_resource_value (value
, 1);
3697 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3698 value
= intern (XSTRING (value
)->data
);
3699 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3700 value
= face_boolean_x_resource_value (value
, 1);
3701 else if (EQ (attr
, QCunderline
)
3702 || EQ (attr
, QCoverline
)
3703 || EQ (attr
, QCstrike_through
)
3704 || EQ (attr
, QCbox
))
3706 Lisp_Object boolean_value
;
3708 /* If the result of face_boolean_x_resource_value is t or nil,
3709 VALUE does NOT specify a color. */
3710 boolean_value
= face_boolean_x_resource_value (value
, 0);
3711 if (SYMBOLP (boolean_value
))
3712 value
= boolean_value
;
3715 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3719 #endif /* HAVE_X_WINDOWS */
3723 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3724 Sinternal_get_lisp_face_attribute
,
3726 "Return face attribute KEYWORD of face SYMBOL.\n\
3727 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
3728 face attribute name, signal an error.\n\
3729 If the optional argument FRAME is given, report on face FACE in that\n\
3730 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
3731 frames). If FRAME is omitted or nil, use the selected frame.")
3732 (symbol
, keyword
, frame
)
3733 Lisp_Object symbol
, keyword
, frame
;
3735 Lisp_Object lface
, value
= Qnil
;
3737 CHECK_SYMBOL (symbol
, 0);
3738 CHECK_SYMBOL (keyword
, 1);
3741 lface
= lface_from_face_name (NULL
, symbol
, 1);
3745 XSETFRAME (frame
, selected_frame
);
3746 CHECK_LIVE_FRAME (frame
, 2);
3747 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3750 if (EQ (keyword
, QCfamily
))
3751 value
= LFACE_FAMILY (lface
);
3752 else if (EQ (keyword
, QCheight
))
3753 value
= LFACE_HEIGHT (lface
);
3754 else if (EQ (keyword
, QCweight
))
3755 value
= LFACE_WEIGHT (lface
);
3756 else if (EQ (keyword
, QCslant
))
3757 value
= LFACE_SLANT (lface
);
3758 else if (EQ (keyword
, QCunderline
))
3759 value
= LFACE_UNDERLINE (lface
);
3760 else if (EQ (keyword
, QCoverline
))
3761 value
= LFACE_OVERLINE (lface
);
3762 else if (EQ (keyword
, QCstrike_through
))
3763 value
= LFACE_STRIKE_THROUGH (lface
);
3764 else if (EQ (keyword
, QCbox
))
3765 value
= LFACE_BOX (lface
);
3766 else if (EQ (keyword
, QCinverse_video
)
3767 || EQ (keyword
, QCreverse_video
))
3768 value
= LFACE_INVERSE (lface
);
3769 else if (EQ (keyword
, QCforeground
))
3770 value
= LFACE_FOREGROUND (lface
);
3771 else if (EQ (keyword
, QCbackground
))
3772 value
= LFACE_BACKGROUND (lface
);
3773 else if (EQ (keyword
, QCstipple
))
3774 value
= LFACE_STIPPLE (lface
);
3775 else if (EQ (keyword
, QCwidth
))
3776 value
= LFACE_SWIDTH (lface
);
3778 signal_error ("Invalid face attribute name", keyword
);
3784 DEFUN ("internal-lisp-face-attribute-values",
3785 Finternal_lisp_face_attribute_values
,
3786 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3787 "Return a list of valid discrete values for face attribute ATTR.\n\
3788 Value is nil if ATTR doesn't have a discrete set of valid values.")
3792 Lisp_Object result
= Qnil
;
3794 CHECK_SYMBOL (attr
, 0);
3796 if (EQ (attr
, QCweight
)
3797 || EQ (attr
, QCslant
)
3798 || EQ (attr
, QCwidth
))
3800 /* Extract permissible symbols from tables. */
3801 struct table_entry
*table
;
3804 if (EQ (attr
, QCweight
))
3805 table
= weight_table
, dim
= DIM (weight_table
);
3806 else if (EQ (attr
, QCslant
))
3807 table
= slant_table
, dim
= DIM (slant_table
);
3809 table
= swidth_table
, dim
= DIM (swidth_table
);
3811 for (i
= 0; i
< dim
; ++i
)
3813 Lisp_Object symbol
= *table
[i
].symbol
;
3814 Lisp_Object tail
= result
;
3817 && !EQ (XCAR (tail
), symbol
))
3821 result
= Fcons (symbol
, result
);
3824 else if (EQ (attr
, QCunderline
))
3825 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3826 else if (EQ (attr
, QCoverline
))
3827 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3828 else if (EQ (attr
, QCstrike_through
))
3829 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3830 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3831 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3837 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3838 Sinternal_merge_in_global_face
, 2, 2, 0,
3839 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
3841 Lisp_Object face
, frame
;
3843 Lisp_Object global_lface
, local_lface
;
3844 CHECK_LIVE_FRAME (frame
, 1);
3845 global_lface
= lface_from_face_name (NULL
, face
, 1);
3846 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3847 if (NILP (local_lface
))
3848 local_lface
= Finternal_make_lisp_face (face
, frame
);
3849 merge_face_vectors (XVECTOR (global_lface
)->contents
,
3850 XVECTOR (local_lface
)->contents
);
3855 /* The following function is implemented for compatibility with 20.2.
3856 The function is used in x-resolve-fonts when it is asked to
3857 return fonts with the same size as the font of a face. This is
3858 done in fontset.el. */
3860 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
3861 "Return the font name of face FACE, or nil if it is unspecified.\n\
3862 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3863 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3864 The font default for a face is either nil, or a list\n\
3865 of the form (bold), (italic) or (bold italic).\n\
3866 If FRAME is omitted or nil, use the selected frame.")
3868 Lisp_Object face
, frame
;
3872 Lisp_Object result
= Qnil
;
3873 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3875 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3876 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3877 result
= Fcons (Qbold
, result
);
3879 if (!NILP (LFACE_SLANT (lface
))
3880 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3881 result
= Fcons (Qitalic
, result
);
3887 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3888 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
3889 struct face
*face
= FACE_FROM_ID (f
, face_id
);
3890 return build_string (face
->font_name
);
3895 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3896 all attributes are `equal'. Tries to be fast because this function
3897 is called quite often. */
3900 lface_equal_p (v1
, v2
)
3901 Lisp_Object
*v1
, *v2
;
3905 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3907 Lisp_Object a
= v1
[i
];
3908 Lisp_Object b
= v2
[i
];
3910 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3911 and the other is specified. */
3912 equal_p
= XTYPE (a
) == XTYPE (b
);
3921 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
3922 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
3923 XSTRING (a
)->size
) == 0);
3932 equal_p
= !NILP (Fequal (a
, b
));
3942 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3943 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3944 "True if FACE1 and FACE2 are equal.\n\
3945 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3946 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3947 If FRAME is omitted or nil, use the selected frame.")
3948 (face1
, face2
, frame
)
3949 Lisp_Object face1
, face2
, frame
;
3953 Lisp_Object lface1
, lface2
;
3958 /* Don't use check_x_frame here because this function is called
3959 before X frames exist. At that time, if FRAME is nil,
3960 selected_frame will be used which is the frame dumped with
3961 Emacs. That frame is not an X frame. */
3962 f
= frame_or_selected_frame (frame
, 2);
3964 lface1
= lface_from_face_name (NULL
, face1
, 1);
3965 lface2
= lface_from_face_name (NULL
, face2
, 1);
3966 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
3967 XVECTOR (lface2
)->contents
);
3968 return equal_p
? Qt
: Qnil
;
3972 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3973 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3974 "True if FACE has no attribute specified.\n\
3975 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3976 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3977 If FRAME is omitted or nil, use the selected frame.")
3979 Lisp_Object face
, frame
;
3989 CHECK_LIVE_FRAME (frame
, 0);
3994 lface
= lface_from_face_name (NULL
, face
, 1);
3996 lface
= lface_from_face_name (f
, face
, 1);
3998 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3999 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4002 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4006 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4008 "Return an alist of frame-local faces defined on FRAME.\n\
4009 For internal use only.")
4013 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4014 return f
->face_alist
;
4018 /* Return a hash code for Lisp string STRING with case ignored. Used
4019 below in computing a hash value for a Lisp face. */
4021 static INLINE
unsigned
4022 hash_string_case_insensitive (string
)
4027 xassert (STRINGP (string
));
4028 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4029 hash
= (hash
<< 1) ^ tolower (*s
);
4034 /* Return a hash code for face attribute vector V. */
4036 static INLINE
unsigned
4040 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4041 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4042 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4043 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4044 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4045 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4046 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4050 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4051 considering charsets/registries). They do if they specify the same
4052 family, point size, weight, width and slant. Both LFACE1 and
4053 LFACE2 must be fully-specified. */
4056 lface_same_font_attributes_p (lface1
, lface2
)
4057 Lisp_Object
*lface1
, *lface2
;
4059 xassert (lface_fully_specified_p (lface1
)
4060 && lface_fully_specified_p (lface2
));
4061 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4062 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4063 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4064 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4065 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4066 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4067 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4072 /***********************************************************************
4074 ***********************************************************************/
4076 /* Allocate and return a new realized face for Lisp face attribute
4077 vector ATTR, charset CHARSET, and registry REGISTRY. */
4079 static struct face
*
4080 make_realized_face (attr
, charset
, registry
)
4083 Lisp_Object registry
;
4085 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4086 bzero (face
, sizeof *face
);
4087 face
->charset
= charset
;
4088 face
->registry
= registry
;
4089 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4094 /* Free realized face FACE, including its X resources. FACE may
4098 free_realized_face (f
, face
)
4104 #ifdef HAVE_X_WINDOWS
4109 x_free_gc (f
, face
->gc
);
4113 free_face_colors (f
, face
);
4114 x_destroy_bitmap (f
, face
->stipple
);
4116 #endif /* HAVE_X_WINDOWS */
4123 /* Prepare face FACE for subsequent display on frame F. This
4124 allocated GCs if they haven't been allocated yet or have been freed
4125 by clearing the face cache. */
4128 prepare_face_for_display (f
, face
)
4132 #ifdef HAVE_X_WINDOWS
4133 xassert (FRAME_X_P (f
));
4138 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4140 xgcv
.foreground
= face
->foreground
;
4141 xgcv
.background
= face
->background
;
4142 xgcv
.graphics_exposures
= False
;
4144 /* The font of FACE may be null if we couldn't load it. */
4147 xgcv
.font
= face
->font
->fid
;
4154 xgcv
.fill_style
= FillOpaqueStippled
;
4155 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4156 mask
|= GCFillStyle
| GCStipple
;
4159 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4166 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4167 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4168 ISO8859-1 if the ASCII face suffices. */
4171 face_suitable_for_iso8859_1_p (face
)
4174 int len
= strlen (face
->font_name
);
4175 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4179 /* Value is non-zero if FACE is suitable for displaying characters
4180 of CHARSET. CHARSET < 0 means unibyte text. */
4183 face_suitable_for_charset_p (face
, charset
)
4191 if (EQ (face
->registry
, Vface_default_registry
)
4192 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4195 else if (face
->charset
== charset
)
4197 else if (face
->charset
== CHARSET_ASCII
4198 && charset
== charset_latin_iso8859_1
)
4199 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4200 else if (face
->charset
== charset_latin_iso8859_1
4201 && charset
== CHARSET_ASCII
)
4209 /***********************************************************************
4211 ***********************************************************************/
4213 /* Return a new face cache for frame F. */
4215 static struct face_cache
*
4219 struct face_cache
*c
;
4222 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4223 bzero (c
, sizeof *c
);
4224 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4225 c
->buckets
= (struct face
**) xmalloc (size
);
4226 bzero (c
->buckets
, size
);
4228 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4234 /* Clear out all graphics contexts for all realized faces, except for
4235 the basic faces. This should be done from time to time just to avoid
4236 keeping too many graphics contexts that are no longer needed. */
4240 struct face_cache
*c
;
4242 if (c
&& FRAME_X_P (c
->f
))
4244 #ifdef HAVE_X_WINDOWS
4246 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4248 struct face
*face
= c
->faces_by_id
[i
];
4249 if (face
&& face
->gc
)
4251 x_free_gc (c
->f
, face
->gc
);
4255 #endif /* HAVE_X_WINDOWS */
4260 /* Free all realized faces in face cache C, including basic faces. C
4261 may be null. If faces are freed, make sure the frame's current
4262 matrix is marked invalid, so that a display caused by an expose
4263 event doesn't try to use faces we destroyed. */
4266 free_realized_faces (c
)
4267 struct face_cache
*c
;
4272 struct frame
*f
= c
->f
;
4274 for (i
= 0; i
< c
->used
; ++i
)
4276 free_realized_face (f
, c
->faces_by_id
[i
]);
4277 c
->faces_by_id
[i
] = NULL
;
4281 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4282 bzero (c
->buckets
, size
);
4284 /* Must do a thorough redisplay the next time. Mark current
4285 matrices as invalid because they will reference faces freed
4286 above. This function is also called when a frame is
4287 destroyed. In this case, the root window of F is nil. */
4288 if (WINDOWP (f
->root_window
))
4290 clear_current_matrices (f
);
4291 ++windows_or_buffers_changed
;
4297 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4298 This is done after attributes of a named face have been changed,
4299 because we can't tell which realized faces depend on that face. */
4302 free_all_realized_faces (frame
)
4308 FOR_EACH_FRAME (rest
, frame
)
4309 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4312 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4316 /* Free face cache C and faces in it, including their X resources. */
4320 struct face_cache
*c
;
4324 free_realized_faces (c
);
4326 xfree (c
->faces_by_id
);
4332 /* Cache realized face FACE in face cache C. HASH is the hash value
4333 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4334 collision list of the face hash table of C. This is done because
4335 otherwise lookup_face would find FACE for every charset, even if
4336 faces with the same attributes but for specific charsets exist. */
4339 cache_face (c
, face
, hash
)
4340 struct face_cache
*c
;
4344 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4348 if (face
->fontset
>= 0)
4350 struct face
*last
= c
->buckets
[i
];
4361 c
->buckets
[i
] = face
;
4362 face
->prev
= face
->next
= NULL
;
4368 face
->next
= c
->buckets
[i
];
4370 face
->next
->prev
= face
;
4371 c
->buckets
[i
] = face
;
4374 /* Find a free slot in C->faces_by_id and use the index of the free
4375 slot as FACE->id. */
4376 for (i
= 0; i
< c
->used
; ++i
)
4377 if (c
->faces_by_id
[i
] == NULL
)
4381 /* Maybe enlarge C->faces_by_id. */
4382 if (i
== c
->used
&& c
->used
== c
->size
)
4384 int new_size
= 2 * c
->size
;
4385 int sz
= new_size
* sizeof *c
->faces_by_id
;
4386 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4391 /* Check that FACE got a unique id. */
4396 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4397 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4403 #endif /* GLYPH_DEBUG */
4405 c
->faces_by_id
[i
] = face
;
4411 /* Remove face FACE from cache C. */
4414 uncache_face (c
, face
)
4415 struct face_cache
*c
;
4418 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4421 face
->prev
->next
= face
->next
;
4423 c
->buckets
[i
] = face
->next
;
4426 face
->next
->prev
= face
->prev
;
4428 c
->faces_by_id
[face
->id
] = NULL
;
4429 if (face
->id
== c
->used
)
4434 /* Look up a realized face with face attributes ATTR in the face cache
4435 of frame F. The face will be used to display characters of
4436 CHARSET. CHARSET < 0 means the face will be used to display
4437 unibyte text. The value of face-default-registry is used to choose
4438 a font for the face in that case. Value is the ID of the face
4439 found. If no suitable face is found, realize a new one. */
4442 lookup_face (f
, attr
, charset
)
4447 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4452 xassert (c
!= NULL
);
4453 check_lface_attrs (attr
);
4455 /* Look up ATTR in the face cache. */
4456 hash
= lface_hash (attr
);
4457 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4459 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4460 if (face
->hash
== hash
4461 && (!FRAME_WINDOW_P (f
)
4462 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4463 && lface_equal_p (face
->lface
, attr
))
4466 /* If not found, realize a new face. */
4469 face
= realize_face (c
, attr
, charset
);
4470 cache_face (c
, face
, hash
);
4474 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4476 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4477 #endif /* GLYPH_DEBUG */
4483 /* Return the face id of the realized face for named face SYMBOL on
4484 frame F suitable for displaying characters from CHARSET. CHARSET <
4485 0 means unibyte text. */
4488 lookup_named_face (f
, symbol
, charset
)
4493 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4494 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4495 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4497 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4498 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4499 merge_face_vectors (symbol_attrs
, attrs
);
4500 return lookup_face (f
, attrs
, charset
);
4504 /* Return the ID of the realized ASCII face of Lisp face with ID
4505 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4508 ascii_face_of_lisp_face (f
, lface_id
)
4514 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4516 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4517 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4526 /* Return a face for charset ASCII that is like the face with id
4527 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4528 STEPS < 0 means larger. Value is the id of the face. */
4531 smaller_face (f
, face_id
, steps
)
4535 #ifdef HAVE_X_WINDOWS
4537 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4538 int pt
, last_pt
, last_height
;
4541 struct face
*new_face
;
4543 /* If not called for an X frame, just return the original face. */
4544 if (FRAME_TERMCAP_P (f
))
4547 /* Try in increments of 1/2 pt. */
4548 delta
= steps
< 0 ? 5 : -5;
4549 steps
= abs (steps
);
4551 face
= FACE_FROM_ID (f
, face_id
);
4552 bcopy (face
->lface
, attrs
, sizeof attrs
);
4553 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4554 new_face_id
= face_id
;
4555 last_height
= FONT_HEIGHT (face
->font
);
4559 /* Give up if we cannot find a font within 10pt. */
4560 && abs (last_pt
- pt
) < 100)
4562 /* Look up a face for a slightly smaller/larger font. */
4564 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4565 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4566 new_face
= FACE_FROM_ID (f
, new_face_id
);
4568 /* If height changes, count that as one step. */
4569 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4572 last_height
= FONT_HEIGHT (new_face
->font
);
4579 #else /* not HAVE_X_WINDOWS */
4583 #endif /* not HAVE_X_WINDOWS */
4587 /* Return a face for charset ASCII that is like the face with id
4588 FACE_ID on frame F, but has height HEIGHT. */
4591 face_with_height (f
, face_id
, height
)
4596 #ifdef HAVE_X_WINDOWS
4598 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4600 if (FRAME_TERMCAP_P (f
)
4604 face
= FACE_FROM_ID (f
, face_id
);
4605 bcopy (face
->lface
, attrs
, sizeof attrs
);
4606 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4607 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4608 #endif /* HAVE_X_WINDOWS */
4613 /* Return the face id of the realized face for named face SYMBOL on
4614 frame F suitable for displaying characters from CHARSET (CHARSET <
4615 0 means unibyte text), and use attributes of the face FACE_ID for
4616 attributes that aren't completely specified by SYMBOL. This is
4617 like lookup_named_face, except that the default attributes come
4618 from FACE_ID, not from the default face. FACE_ID is assumed to
4619 be already realized. */
4622 lookup_derived_face (f
, symbol
, charset
, face_id
)
4628 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4629 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4630 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4635 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4636 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4637 merge_face_vectors (symbol_attrs
, attrs
);
4638 return lookup_face (f
, attrs
, charset
);
4643 /***********************************************************************
4645 ***********************************************************************/
4647 DEFUN ("internal-set-font-selection-order",
4648 Finternal_set_font_selection_order
,
4649 Sinternal_set_font_selection_order
, 1, 1, 0,
4650 "Set font selection order for face font selection to ORDER.\n\
4651 ORDER must be a list of length 4 containing the symbols `:width',\n\
4652 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4653 first in ORDER are matched first, e.g. if `:height' appears before\n\
4654 `:weight' in ORDER, font selection first tries to find a font with\n\
4655 a suitable height, and then tries to match the font weight.\n\
4664 CHECK_LIST (order
, 0);
4665 bzero (indices
, sizeof indices
);
4669 CONSP (list
) && i
< DIM (indices
);
4670 list
= XCDR (list
), ++i
)
4672 Lisp_Object attr
= XCAR (list
);
4675 if (EQ (attr
, QCwidth
))
4677 else if (EQ (attr
, QCheight
))
4678 xlfd
= XLFD_POINT_SIZE
;
4679 else if (EQ (attr
, QCweight
))
4681 else if (EQ (attr
, QCslant
))
4686 if (indices
[i
] != 0)
4692 || i
!= DIM (indices
)
4697 signal_error ("Invalid font sort order", order
);
4699 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4701 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4702 free_all_realized_faces (Qnil
);
4709 DEFUN ("internal-set-alternative-font-family-alist",
4710 Finternal_set_alternative_font_family_alist
,
4711 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
4712 "Define alternative font families to try in face font selection.\n\
4713 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4714 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
4715 be found. Value is ALIST.")
4719 CHECK_LIST (alist
, 0);
4720 Vface_alternative_font_family_alist
= alist
;
4721 free_all_realized_faces (Qnil
);
4726 #ifdef HAVE_X_WINDOWS
4728 /* Return the X registry and encoding of font name FONT_NAME on frame F.
4729 Value is nil if not successful. */
4732 deduce_unibyte_registry (f
, font_name
)
4736 struct font_name font
;
4737 Lisp_Object registry
= Qnil
;
4739 font
.name
= STRDUPA (font_name
);
4740 if (split_font_name (f
, &font
, 0))
4744 /* Extract registry and encoding. */
4745 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
4746 + strlen (font
.fields
[XLFD_ENCODING
])
4748 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
4749 strcat (buffer
, "-");
4750 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
4751 registry
= build_string (buffer
);
4758 /* Value is non-zero if FONT is the name of a scalable font. The
4759 X11R6 XLFD spec says that point size, pixel size, and average width
4760 are zero for scalable fonts. Intlfonts contain at least one
4761 scalable font ("*-muleindian-1") for which this isn't true, so we
4762 just test average width. */
4765 font_scalable_p (font
)
4766 struct font_name
*font
;
4768 char *s
= font
->fields
[XLFD_AVGWIDTH
];
4769 return *s
== '0' && *(s
+ 1) == '\0';
4773 /* Value is non-zero if FONT1 is a better match for font attributes
4774 VALUES than FONT2. VALUES is an array of face attribute values in
4775 font sort order. COMPARE_PT_P zero means don't compare point
4779 better_font_p (values
, font1
, font2
, compare_pt_p
)
4781 struct font_name
*font1
, *font2
;
4786 for (i
= 0; i
< 4; ++i
)
4788 int xlfd_idx
= font_sort_order
[i
];
4790 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
4792 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
4793 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
4795 if (delta1
> delta2
)
4797 else if (delta1
< delta2
)
4801 /* The difference may be equal because, e.g., the face
4802 specifies `italic' but we have only `regular' and
4803 `oblique'. Prefer `oblique' in this case. */
4804 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
4805 && font1
->numeric
[xlfd_idx
] > values
[i
]
4806 && font2
->numeric
[xlfd_idx
] < values
[i
])
4818 /* Value is non-zero if FONT is an exact match for face attributes in
4819 SPECIFIED. SPECIFIED is an array of face attribute values in font
4823 exact_face_match_p (specified
, font
)
4825 struct font_name
*font
;
4829 for (i
= 0; i
< 4; ++i
)
4830 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
4837 /* Value is the name of a scaled font, generated from scalable font
4838 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
4839 Value is allocated from heap. */
4842 build_scalable_font_name (f
, font
, specified_pt
)
4844 struct font_name
*font
;
4847 char point_size
[20], pixel_size
[20];
4849 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
4852 /* If scalable font is for a specific resolution, compute
4853 the point size we must specify from the resolution of
4854 the display and the specified resolution of the font. */
4855 if (font
->numeric
[XLFD_RESY
] != 0)
4857 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
4858 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
4863 pixel_value
= resy
/ 720.0 * pt
;
4866 /* Set point size of the font. */
4867 sprintf (point_size
, "%d", (int) pt
);
4868 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
4869 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
4871 /* Set pixel size. */
4872 sprintf (pixel_size
, "%d", pixel_value
);
4873 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
4874 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
4876 /* If font doesn't specify its resolution, use the
4877 resolution of the display. */
4878 if (font
->numeric
[XLFD_RESY
] == 0)
4881 sprintf (buffer
, "%d", (int) resy
);
4882 font
->fields
[XLFD_RESY
] = buffer
;
4883 font
->numeric
[XLFD_RESY
] = resy
;
4886 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
4889 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
4890 sprintf (buffer
, "%d", resx
);
4891 font
->fields
[XLFD_RESX
] = buffer
;
4892 font
->numeric
[XLFD_RESX
] = resx
;
4895 return build_font_name (font
);
4899 /* Value is non-zero if we are allowed to use scalable font FONT. We
4900 can't run a Lisp function here since this function may be called
4901 with input blocked. */
4904 may_use_scalable_font_p (font
, name
)
4905 struct font_name
*font
;
4908 if (EQ (Vscalable_fonts_allowed
, Qt
))
4910 else if (CONSP (Vscalable_fonts_allowed
))
4912 Lisp_Object tail
, regexp
;
4914 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
4916 regexp
= XCAR (tail
);
4917 if (STRINGP (regexp
)
4918 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
4926 #endif /* SCALABLE_FONTS != 0 */
4929 /* Return the name of the best matching font for face attributes
4930 ATTRS in the array of font_name structures FONTS which contains
4931 NFONTS elements. Value is a font name which is allocated from
4932 the heap. FONTS is freed by this function. */
4935 best_matching_font (f
, attrs
, fonts
, nfonts
)
4938 struct font_name
*fonts
;
4942 struct font_name
*best
;
4950 /* Make specified font attributes available in `specified',
4951 indexed by sort order. */
4952 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
4954 int xlfd_idx
= font_sort_order
[i
];
4956 if (xlfd_idx
== XLFD_SWIDTH
)
4957 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
4958 else if (xlfd_idx
== XLFD_POINT_SIZE
)
4959 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4960 else if (xlfd_idx
== XLFD_WEIGHT
)
4961 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
4962 else if (xlfd_idx
== XLFD_SLANT
)
4963 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
4973 /* Start with the first non-scalable font in the list. */
4974 for (i
= 0; i
< nfonts
; ++i
)
4975 if (!font_scalable_p (fonts
+ i
))
4978 /* Find the best match among the non-scalable fonts. */
4983 for (i
= 1; i
< nfonts
; ++i
)
4984 if (!font_scalable_p (fonts
+ i
)
4985 && better_font_p (specified
, fonts
+ i
, best
, 1))
4989 exact_p
= exact_face_match_p (specified
, best
);
4998 /* Unless we found an exact match among non-scalable fonts, see if
4999 we can find a better match among scalable fonts. */
5002 /* A scalable font is better if
5004 1. its weight, slant, swidth attributes are better, or.
5006 2. the best non-scalable font doesn't have the required
5007 point size, and the scalable fonts weight, slant, swidth
5010 int non_scalable_has_exact_height_p
;
5012 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5013 non_scalable_has_exact_height_p
= 1;
5015 non_scalable_has_exact_height_p
= 0;
5017 for (i
= 0; i
< nfonts
; ++i
)
5018 if (font_scalable_p (fonts
+ i
))
5021 || better_font_p (specified
, fonts
+ i
, best
, 0)
5022 || (!non_scalable_has_exact_height_p
5023 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5028 if (font_scalable_p (best
))
5029 font_name
= build_scalable_font_name (f
, best
, pt
);
5031 font_name
= build_font_name (best
);
5033 #else /* !SCALABLE_FONTS */
5035 /* Find the best non-scalable font. */
5038 for (i
= 1; i
< nfonts
; ++i
)
5040 xassert (!font_scalable_p (fonts
+ i
));
5041 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5045 font_name
= build_font_name (best
);
5047 #endif /* !SCALABLE_FONTS */
5049 /* Free font_name structures. */
5050 free_font_names (fonts
, nfonts
);
5056 /* Try to get a list of fonts on frame F with font family FAMILY and
5057 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5058 of font_name structures for the fonts matched. Value is the number
5062 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5065 char *pattern
, *family
, *registry
;
5066 struct font_name
**fonts
;
5071 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5073 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5079 /* Try alternative font families from
5080 Vface_alternative_font_family_alist. */
5081 alter
= Fassoc (build_string (family
),
5082 Vface_alternative_font_family_alist
);
5084 for (alter
= XCDR (alter
);
5085 CONSP (alter
) && nfonts
== 0;
5086 alter
= XCDR (alter
))
5088 if (STRINGP (XCAR (alter
)))
5090 family
= LSTRDUPA (XCAR (alter
));
5091 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5095 /* Try font family of the default face or "fixed". */
5098 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5100 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5103 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5106 /* Try any family with the given registry. */
5108 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5115 /* Return the registry and encoding pattern that fonts for CHARSET
5116 should match. Value is allocated from the heap. */
5119 x_charset_registry (charset
)
5122 Lisp_Object prop
, charset_plist
;
5125 /* Get registry and encoding from the charset's plist. */
5126 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5127 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5131 if (index (XSTRING (prop
)->data
, '-'))
5132 registry
= xstrdup (XSTRING (prop
)->data
);
5135 /* If registry doesn't contain a `-', make it a pattern. */
5136 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5137 strcpy (registry
, XSTRING (prop
)->data
);
5138 strcat (registry
, "*-*");
5141 else if (STRINGP (Vface_default_registry
))
5142 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5144 registry
= xstrdup ("iso8859-1");
5150 /* Return the fontset id of the fontset name or alias name given by
5151 the family attribute of ATTRS on frame F. Value is -1 if the
5152 family attribute of ATTRS doesn't name a fontset. */
5155 face_fontset (f
, attrs
)
5159 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5162 name
= Fquery_fontset (name
, Qnil
);
5166 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5172 /* Get the font to use for the face realizing the fully-specified Lisp
5173 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5174 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5175 in this case. Value is the font name which is allocated from the
5176 heap (which means that it must be freed eventually). */
5179 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5183 Lisp_Object unibyte_registry
;
5185 struct font_name
*fonts
;
5189 /* ATTRS must be fully-specified. */
5190 xassert (lface_fully_specified_p (attrs
));
5192 if (STRINGP (unibyte_registry
))
5193 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5195 registry
= x_charset_registry (charset
);
5197 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5199 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5203 /* Choose a font to use on frame F to display CHARSET using FONTSET
5204 with Lisp face attributes specified by ATTRS. CHARSET may be any
5205 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
5206 unibyte text. If the fontset doesn't contain a font pattern for
5207 charset, use the pattern for CHARSET_ASCII. Value is the font name
5208 which is allocated from the heap and must be freed by the caller. */
5211 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5214 int fontset
, charset
;
5217 char *font_name
= NULL
;
5218 struct fontset_info
*fontset_info
;
5219 struct font_name
*fonts
;
5222 xassert (charset
!= CHARSET_COMPOSITION
);
5223 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5225 /* For unibyte text, use the ASCII font of the fontset. Using the
5226 ASCII font seems to be the most reasonable thing we can do in
5229 charset
= CHARSET_ASCII
;
5231 /* Get the font name pattern to use for CHARSET from the fontset. */
5232 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5233 pattern
= fontset_info
->fontname
[charset
];
5235 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5238 /* Get a list of fonts matching that pattern and choose the
5239 best match for the specified face attributes from it. */
5240 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5241 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5245 #endif /* HAVE_X_WINDOWS */
5249 /***********************************************************************
5251 ***********************************************************************/
5253 /* Realize basic faces on frame F. Value is zero if frame parameters
5254 of F don't contain enough information needed to realize the default
5258 realize_basic_faces (f
)
5263 if (realize_default_face (f
))
5265 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5266 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5267 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5268 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5269 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5270 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5271 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5272 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5280 /* Realize the default face on frame F. If the face is not fully
5281 specified, make it fully-specified. Attributes of the default face
5282 that are not explicitly specified are taken from frame parameters. */
5285 realize_default_face (f
)
5288 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5290 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5291 Lisp_Object unibyte_registry
;
5292 Lisp_Object frame_font
;
5296 /* If the `default' face is not yet known, create it. */
5297 lface
= lface_from_face_name (f
, Qdefault
, 0);
5301 XSETFRAME (frame
, f
);
5302 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5305 #ifdef HAVE_X_WINDOWS
5308 /* Set frame_font to the value of the `font' frame parameter. */
5309 frame_font
= Fassq (Qfont
, f
->param_alist
);
5310 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5311 frame_font
= XCDR (frame_font
);
5313 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5316 /* If frame_font is a fontset name, don't use that for
5317 determining font-related attributes of the default face
5318 because it is just an artificial name. Use the ASCII font of
5319 the fontset, instead. */
5320 struct font_info
*font_info
;
5321 struct font_name font
;
5324 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5328 /* Set weight etc. from the ASCII font. */
5329 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0))
5332 /* Remember registry and encoding of the frame font. */
5333 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5334 if (STRINGP (unibyte_registry
))
5335 Vface_default_registry
= unibyte_registry
;
5337 Vface_default_registry
= build_string ("iso8859-1");
5339 /* But set the family to the fontset alias name. Implementation
5340 note: When a font is passed to Emacs via `-fn FONT', a
5341 fontset is created in `x-win.el' whose name ends in
5342 `fontset-startup'. This fontset has an alias name that is
5343 equal to frame_font. */
5344 xassert (STRINGP (frame_font
));
5345 font
.name
= LSTRDUPA (frame_font
);
5347 if (!split_font_name (f
, &font
, 1)
5348 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5349 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5350 LFACE_FAMILY (lface
) = frame_font
;
5354 /* Frame parameters contain a real font. Fill default face
5355 attributes from that font. */
5356 if (!set_lface_from_font_name (f
, lface
,
5357 XSTRING (frame_font
)->data
, 0))
5360 /* Remember registry and encoding of the frame font. */
5362 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5363 if (STRINGP (unibyte_registry
))
5364 Vface_default_registry
= unibyte_registry
;
5366 Vface_default_registry
= build_string ("iso8859-1");
5369 #endif /* HAVE_X_WINDOWS */
5371 if (!FRAME_WINDOW_P (f
))
5373 LFACE_FAMILY (lface
) = build_string ("default");
5374 LFACE_SWIDTH (lface
) = Qnormal
;
5375 LFACE_HEIGHT (lface
) = make_number (1);
5376 LFACE_WEIGHT (lface
) = Qnormal
;
5377 LFACE_SLANT (lface
) = Qnormal
;
5380 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5381 LFACE_UNDERLINE (lface
) = Qnil
;
5383 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5384 LFACE_OVERLINE (lface
) = Qnil
;
5386 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5387 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5389 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5390 LFACE_BOX (lface
) = Qnil
;
5392 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5393 LFACE_INVERSE (lface
) = Qnil
;
5395 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5397 /* This function is called so early that colors are not yet
5398 set in the frame parameter list. */
5399 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5401 if (CONSP (color
) && STRINGP (XCDR (color
)))
5402 LFACE_FOREGROUND (lface
) = XCDR (color
);
5403 else if (FRAME_X_P (f
))
5405 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5406 /* Frame parameters for terminal frames usually don't contain
5407 a color. Use an empty string to indicate that the face
5408 should use the (unknown) default color of the terminal. */
5409 LFACE_FOREGROUND (lface
) = build_string ("");
5414 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5416 /* This function is called so early that colors are not yet
5417 set in the frame parameter list. */
5418 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5419 if (CONSP (color
) && STRINGP (XCDR (color
)))
5420 LFACE_BACKGROUND (lface
) = XCDR (color
);
5421 else if (FRAME_X_P (f
))
5423 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5424 /* Frame parameters for terminal frames usually don't contain
5425 a color. Use an empty string to indicate that the face
5426 should use the (unknown) default color of the terminal. */
5427 LFACE_BACKGROUND (lface
) = build_string ("");
5432 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5433 LFACE_STIPPLE (lface
) = Qnil
;
5435 /* Realize the face; it must be fully-specified now. */
5436 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5437 check_lface (lface
);
5438 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5439 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5441 /* Remove the former default face. */
5442 if (c
->used
> DEFAULT_FACE_ID
)
5444 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5445 uncache_face (c
, default_face
);
5446 free_realized_face (f
, default_face
);
5449 /* Insert the new default face. */
5450 cache_face (c
, face
, lface_hash (attrs
));
5451 xassert (face
->id
== DEFAULT_FACE_ID
);
5456 /* Realize basic faces other than the default face in face cache C.
5457 SYMBOL is the face name, ID is the face id the realized face must
5458 have. The default face must have been realized already. */
5461 realize_named_face (f
, symbol
, id
)
5466 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5467 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5468 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5469 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5470 struct face
*new_face
;
5472 /* The default face must exist and be fully specified. */
5473 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5474 check_lface_attrs (attrs
);
5475 xassert (lface_fully_specified_p (attrs
));
5477 /* If SYMBOL isn't know as a face, create it. */
5481 XSETFRAME (frame
, f
);
5482 lface
= Finternal_make_lisp_face (symbol
, frame
);
5485 /* Merge SYMBOL's face with the default face. */
5486 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5487 merge_face_vectors (symbol_attrs
, attrs
);
5489 /* Realize the face. */
5490 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5492 /* Remove the former face. */
5495 struct face
*old_face
= c
->faces_by_id
[id
];
5496 uncache_face (c
, old_face
);
5497 free_realized_face (f
, old_face
);
5500 /* Insert the new face. */
5501 cache_face (c
, new_face
, lface_hash (attrs
));
5502 xassert (new_face
->id
== id
);
5506 /* Realize the fully-specified face with attributes ATTRS in face
5507 cache C for character set CHARSET or for unibyte text if CHARSET <
5508 0. Value is a pointer to the newly created realized face. */
5510 static struct face
*
5511 realize_face (c
, attrs
, charset
)
5512 struct face_cache
*c
;
5518 /* LFACE must be fully specified. */
5519 xassert (c
!= NULL
);
5520 check_lface_attrs (attrs
);
5522 if (FRAME_X_P (c
->f
))
5523 face
= realize_x_face (c
, attrs
, charset
);
5524 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5525 face
= realize_tty_face (c
, attrs
, charset
);
5533 /* Realize the fully-specified face with attributes ATTRS in face
5534 cache C for character set CHARSET or for unibyte text if CHARSET <
5535 0. Do it for X frame C->f. Value is a pointer to the newly
5536 created realized face. */
5538 static struct face
*
5539 realize_x_face (c
, attrs
, charset
)
5540 struct face_cache
*c
;
5544 #ifdef HAVE_X_WINDOWS
5545 struct face
*face
, *default_face
;
5546 struct frame
*f
= c
->f
;
5547 Lisp_Object stipple
, overline
, strike_through
, box
;
5548 Lisp_Object unibyte_registry
;
5549 struct gcpro gcpro1
;
5551 xassert (FRAME_X_P (f
));
5553 /* If realizing a face for use in unibyte text, get the X registry
5554 and encoding to use from Vface_default_registry. */
5556 unibyte_registry
= (STRINGP (Vface_default_registry
)
5557 ? Vface_default_registry
5558 : build_string ("iso8859-1"));
5560 unibyte_registry
= Qnil
;
5561 GCPRO1 (unibyte_registry
);
5563 /* Allocate a new realized face. */
5564 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5566 /* Determine the font to use. Most of the time, the font will be
5567 the same as the font of the default face, so try that first. */
5568 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5570 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5571 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5573 face
->font
= default_face
->font
;
5574 face
->fontset
= default_face
->fontset
;
5575 face
->font_info_id
= default_face
->font_info_id
;
5576 face
->font_name
= default_face
->font_name
;
5577 face
->registry
= default_face
->registry
;
5579 else if (charset
>= 0)
5581 /* For all charsets except CHARSET_COMPOSITION, we use our own
5582 font selection functions to choose a best matching font for
5583 the specified face attributes. If the face specifies a
5584 fontset alias name, the fontset determines the font name
5585 pattern, otherwise we construct a font pattern from face
5586 attributes and charset.
5588 If charset is CHARSET_COMPOSITION, we always construct a face
5589 with a fontset, even if the face doesn't specify a fontset alias
5590 (we use fontset-standard in that case). When the composite
5591 character is displayed in xterm.c, a suitable concrete font is
5592 loaded in x_get_char_font_and_encoding. */
5594 char *font_name
= NULL
;
5595 int fontset
= face_fontset (f
, attrs
);
5597 if (charset
== CHARSET_COMPOSITION
)
5598 fontset
= max (0, fontset
);
5599 else if (fontset
< 0)
5600 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5603 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5607 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5612 /* Unibyte case, and font is not equal to that of the default
5613 face. UNIBYTE_REGISTRY is the X registry and encoding the
5614 font should have. What is a reasonable thing to do if the
5615 user specified a fontset alias name for the face in this
5616 case? We choose a font by taking the ASCII font of the
5617 fontset, but using UNIBYTE_REGISTRY for its registry and
5620 char *font_name
= NULL
;
5621 int fontset
= face_fontset (f
, attrs
);
5624 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5626 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5628 load_face_font_or_fontset (f
, face
, font_name
, -1);
5632 /* Load colors, and set remaining attributes. */
5634 load_face_colors (f
, face
, attrs
);
5637 box
= attrs
[LFACE_BOX_INDEX
];
5640 /* A simple box of line width 1 drawn in color given by
5642 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5644 face
->box
= FACE_SIMPLE_BOX
;
5645 face
->box_line_width
= 1;
5647 else if (INTEGERP (box
))
5649 /* Simple box of specified line width in foreground color of the
5651 xassert (XINT (box
) > 0);
5652 face
->box
= FACE_SIMPLE_BOX
;
5653 face
->box_line_width
= XFASTINT (box
);
5654 face
->box_color
= face
->foreground
;
5655 face
->box_color_defaulted_p
= 1;
5657 else if (CONSP (box
))
5659 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5660 being one of `raised' or `sunken'. */
5661 face
->box
= FACE_SIMPLE_BOX
;
5662 face
->box_color
= face
->foreground
;
5663 face
->box_color_defaulted_p
= 1;
5664 face
->box_line_width
= 1;
5668 Lisp_Object keyword
, value
;
5670 keyword
= XCAR (box
);
5678 if (EQ (keyword
, QCline_width
))
5680 if (INTEGERP (value
) && XINT (value
) > 0)
5681 face
->box_line_width
= XFASTINT (value
);
5683 else if (EQ (keyword
, QCcolor
))
5685 if (STRINGP (value
))
5687 face
->box_color
= load_color (f
, face
, value
,
5689 face
->use_box_color_for_shadows_p
= 1;
5692 else if (EQ (keyword
, QCstyle
))
5694 if (EQ (value
, Qreleased_button
))
5695 face
->box
= FACE_RAISED_BOX
;
5696 else if (EQ (value
, Qpressed_button
))
5697 face
->box
= FACE_SUNKEN_BOX
;
5702 /* Text underline, overline, strike-through. */
5704 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5706 /* Use default color (same as foreground color). */
5707 face
->underline_p
= 1;
5708 face
->underline_defaulted_p
= 1;
5709 face
->underline_color
= 0;
5711 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5713 /* Use specified color. */
5714 face
->underline_p
= 1;
5715 face
->underline_defaulted_p
= 0;
5716 face
->underline_color
5717 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5718 LFACE_UNDERLINE_INDEX
);
5720 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5722 face
->underline_p
= 0;
5723 face
->underline_defaulted_p
= 0;
5724 face
->underline_color
= 0;
5727 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5728 if (STRINGP (overline
))
5730 face
->overline_color
5731 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5732 LFACE_OVERLINE_INDEX
);
5733 face
->overline_p
= 1;
5735 else if (EQ (overline
, Qt
))
5737 face
->overline_color
= face
->foreground
;
5738 face
->overline_color_defaulted_p
= 1;
5739 face
->overline_p
= 1;
5742 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5743 if (STRINGP (strike_through
))
5745 face
->strike_through_color
5746 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5747 LFACE_STRIKE_THROUGH_INDEX
);
5748 face
->strike_through_p
= 1;
5750 else if (EQ (strike_through
, Qt
))
5752 face
->strike_through_color
= face
->foreground
;
5753 face
->strike_through_color_defaulted_p
= 1;
5754 face
->strike_through_p
= 1;
5757 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5758 if (!NILP (stipple
))
5759 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5762 xassert (face
->fontset
< 0 || face
->charset
== CHARSET_COMPOSITION
);
5763 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
5765 #endif /* HAVE_X_WINDOWS */
5769 /* Realize the fully-specified face with attributes ATTRS in face
5770 cache C for character set CHARSET or for unibyte text if CHARSET <
5771 0. Do it for TTY frame C->f. Value is a pointer to the newly
5772 created realized face. */
5774 static struct face
*
5775 realize_tty_face (c
, attrs
, charset
)
5776 struct face_cache
*c
;
5784 /* Frame must be a termcap frame. */
5785 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
5787 /* Allocate a new realized face. */
5788 face
= make_realized_face (attrs
, charset
, Qnil
);
5789 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
5791 /* Map face attributes to TTY appearances. We map slant to
5792 dimmed text because we want italic text to appear differently
5793 and because dimmed text is probably used infrequently. */
5794 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5795 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5797 if (weight
> XLFD_WEIGHT_MEDIUM
)
5798 face
->tty_bold_p
= 1;
5799 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
5800 face
->tty_dim_p
= 1;
5801 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5802 face
->tty_underline_p
= 1;
5803 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5804 face
->tty_reverse_p
= 1;
5806 /* Map color names to color indices. */
5807 face
->foreground
= face
->background
= FACE_TTY_DEFAULT_COLOR
;
5809 color
= attrs
[LFACE_FOREGROUND_INDEX
];
5810 if (XSTRING (color
)->size
5811 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5813 face
->foreground
= XINT (XCDR (color
));
5816 if (FRAME_MSDOS_P (c
->f
) && face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
5818 face
->foreground
= load_color (c
->f
, face
,
5819 attrs
[LFACE_FOREGROUND_INDEX
],
5820 LFACE_FOREGROUND_INDEX
);
5821 /* If the foreground of the default face is the default color,
5822 use the foreground color defined by the frame. */
5823 if (face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
5825 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
5826 attrs
[LFACE_FOREGROUND_INDEX
] =
5827 build_string (msdos_stdcolor_name (face
->foreground
));
5832 color
= attrs
[LFACE_BACKGROUND_INDEX
];
5833 if (XSTRING (color
)->size
5834 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5836 face
->background
= XINT (XCDR (color
));
5839 if (FRAME_MSDOS_P (c
->f
) && face
->background
== FACE_TTY_DEFAULT_COLOR
)
5841 face
->background
= load_color (c
->f
, face
,
5842 attrs
[LFACE_BACKGROUND_INDEX
],
5843 LFACE_BACKGROUND_INDEX
);
5844 /* If the background of the default face is the default color,
5845 use the background color defined by the frame. */
5846 if (face
->background
== FACE_TTY_DEFAULT_COLOR
)
5848 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
5849 attrs
[LFACE_BACKGROUND_INDEX
] =
5850 build_string (msdos_stdcolor_name (face
->background
));
5854 /* Swap colors if face is inverse-video. */
5855 if (face
->tty_reverse_p
)
5857 unsigned long tem
= face
->foreground
;
5859 face
->foreground
= face
->background
;
5860 face
->background
= tem
;
5868 DEFUN ("face-register-tty-color", Fface_register_tty_color
,
5869 Sface_register_tty_color
, 2, 2, 0,
5870 "Say that COLOR is color number NUMBER on the terminal.\n\
5871 COLOR is a string, the color name. Value is COLOR.")
5873 Lisp_Object color
, number
;
5877 CHECK_STRING (color
, 0);
5878 CHECK_NUMBER (number
, 1);
5879 entry
= Fassoc (color
, Vface_tty_color_alist
);
5881 Vface_tty_color_alist
= Fcons (Fcons (color
, number
),
5882 Vface_tty_color_alist
);
5884 Fsetcdr (entry
, number
);
5889 DEFUN ("face-clear-tty-colors", Fface_clear_tty_colors
,
5890 Sface_clear_tty_colors
, 0, 0, 0,
5891 "Unregister all registered tty colors.")
5894 return Vface_tty_color_alist
= Qnil
;
5898 DEFUN ("tty-defined-colors", Ftty_defined_colors
,
5899 Stty_defined_colors
, 0, 0, 0,
5900 "Return a list of registered tty colors.")
5903 Lisp_Object list
, colors
;
5906 for (list
= Vface_tty_color_alist
; CONSP (list
); list
= XCDR (list
))
5907 colors
= Fcons (XCAR (XCAR (list
)), colors
);
5914 /***********************************************************************
5916 ***********************************************************************/
5918 /* Return the ID of the face to use to display character CH with face
5919 property PROP on frame F in current_buffer. */
5922 compute_char_face (f
, ch
, prop
)
5928 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
5930 : CHAR_CHARSET (ch
));
5933 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
5936 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5937 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5938 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5939 merge_face_vector_with_property (f
, attrs
, prop
);
5940 face_id
= lookup_face (f
, attrs
, charset
);
5947 /* Return the face ID associated with buffer position POS for
5948 displaying ASCII characters. Return in *ENDPTR the position at
5949 which a different face is needed, as far as text properties and
5950 overlays are concerned. W is a window displaying current_buffer.
5952 REGION_BEG, REGION_END delimit the region, so it can be
5955 LIMIT is a position not to scan beyond. That is to limit the time
5956 this function can take.
5958 If MOUSE is non-zero, use the character's mouse-face, not its face.
5960 The face returned is suitable for displaying CHARSET_ASCII if
5961 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
5962 the face is suitable for displaying unibyte text. */
5965 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
5966 endptr
, limit
, mouse
)
5969 int region_beg
, region_end
;
5974 struct frame
*f
= XFRAME (w
->frame
);
5975 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5976 Lisp_Object prop
, position
;
5978 Lisp_Object
*overlay_vec
;
5981 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5982 Lisp_Object limit1
, end
;
5983 struct face
*default_face
;
5984 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
5986 /* W must display the current buffer. We could write this function
5987 to use the frame and buffer of W, but right now it doesn't. */
5988 /* xassert (XBUFFER (w->buffer) == current_buffer); */
5990 XSETFRAME (frame
, f
);
5991 XSETFASTINT (position
, pos
);
5994 if (pos
< region_beg
&& region_beg
< endpos
)
5995 endpos
= region_beg
;
5997 /* Get the `face' or `mouse_face' text property at POS, and
5998 determine the next position at which the property changes. */
5999 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6000 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6001 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6003 endpos
= XINT (end
);
6005 /* Look at properties from overlays. */
6010 /* First try with room for 40 overlays. */
6012 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6013 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6014 &next_overlay
, NULL
);
6016 /* If there are more than 40, make enough space for all, and try
6018 if (noverlays
> len
)
6021 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6022 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6023 &next_overlay
, NULL
);
6026 if (next_overlay
< endpos
)
6027 endpos
= next_overlay
;
6032 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6034 /* Optimize common cases where we can use the default face. */
6037 && !(pos
>= region_beg
&& pos
< region_end
)
6039 || !FRAME_WINDOW_P (f
)
6040 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6041 return DEFAULT_FACE_ID
;
6043 /* Begin with attributes from the default face. */
6044 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6046 /* Merge in attributes specified via text properties. */
6048 merge_face_vector_with_property (f
, attrs
, prop
);
6050 /* Now merge the overlay data. */
6051 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6052 for (i
= 0; i
< noverlays
; i
++)
6057 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6059 merge_face_vector_with_property (f
, attrs
, prop
);
6061 oend
= OVERLAY_END (overlay_vec
[i
]);
6062 oendpos
= OVERLAY_POSITION (oend
);
6063 if (oendpos
< endpos
)
6067 /* If in the region, merge in the region face. */
6068 if (pos
>= region_beg
&& pos
< region_end
)
6070 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6071 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6073 if (region_end
< endpos
)
6074 endpos
= region_end
;
6079 /* Look up a realized face with the given face attributes,
6080 or realize a new one. Charset is ignored for tty frames. */
6081 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6085 /* Compute the face at character position POS in Lisp string STRING on
6086 window W, for charset CHARSET_ASCII.
6088 If STRING is an overlay string, it comes from position BUFPOS in
6089 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6090 not an overlay string. W must display the current buffer.
6091 REGION_BEG and REGION_END give the start and end positions of the
6092 region; both are -1 if no region is visible. BASE_FACE_ID is the
6093 id of the basic face to merge with. It is usually equal to
6094 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6095 for strings displayed in the mode or top line.
6097 Set *ENDPTR to the next position where to check for faces in
6098 STRING; -1 if the face is constant from POS to the end of the
6101 Value is the id of the face to use. The face returned is suitable
6102 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6103 the face is suitable for displaying unibyte text. */
6106 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6107 region_end
, endptr
, base_face_id
)
6111 int region_beg
, region_end
;
6113 enum face_id base_face_id
;
6115 Lisp_Object prop
, position
, end
, limit
;
6116 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6117 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6118 struct face
*base_face
;
6119 int multibyte_p
= STRING_MULTIBYTE (string
);
6121 /* Get the value of the face property at the current position within
6122 STRING. Value is nil if there is no face property. */
6123 XSETFASTINT (position
, pos
);
6124 prop
= Fget_text_property (position
, Qface
, string
);
6126 /* Get the next position at which to check for faces. Value of end
6127 is nil if face is constant all the way to the end of the string.
6128 Otherwise it is a string position where to check faces next.
6129 Limit is the maximum position up to which to check for property
6130 changes in Fnext_single_property_change. Strings are usually
6131 short, so set the limit to the end of the string. */
6132 XSETFASTINT (limit
, XSTRING (string
)->size
);
6133 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6135 *endptr
= XFASTINT (end
);
6139 base_face
= FACE_FROM_ID (f
, base_face_id
);
6140 xassert (base_face
);
6142 /* Optimize the default case that there is no face property and we
6143 are not in the region. */
6145 && (base_face_id
!= DEFAULT_FACE_ID
6146 /* BUFPOS <= 0 means STRING is not an overlay string, so
6147 that the region doesn't have to be taken into account. */
6149 || bufpos
< region_beg
6150 || bufpos
>= region_end
)
6152 /* We can't realize faces for different charsets differently
6153 if we don't have fonts, so we can stop here if not working
6154 on a window-system frame. */
6155 || !FRAME_WINDOW_P (f
)
6156 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6157 return base_face
->id
;
6159 /* Begin with attributes from the base face. */
6160 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6162 /* Merge in attributes specified via text properties. */
6164 merge_face_vector_with_property (f
, attrs
, prop
);
6166 /* If in the region, merge in the region face. */
6168 && bufpos
>= region_beg
6169 && bufpos
< region_end
)
6171 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6172 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6175 /* Look up a realized face with the given face attributes,
6176 or realize a new one. */
6177 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6182 /***********************************************************************
6184 ***********************************************************************/
6188 /* Print the contents of the realized face FACE to stderr. */
6191 dump_realized_face (face
)
6194 fprintf (stderr
, "ID: %d\n", face
->id
);
6195 #ifdef HAVE_X_WINDOWS
6196 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6198 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6200 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6201 fprintf (stderr
, "background: 0x%lx (%s)\n",
6203 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6204 fprintf (stderr
, "font_name: %s (%s)\n",
6206 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6207 #ifdef HAVE_X_WINDOWS
6208 fprintf (stderr
, "font = %p\n", face
->font
);
6210 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6211 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6212 fprintf (stderr
, "underline: %d (%s)\n",
6214 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6215 fprintf (stderr
, "hash: %d\n", face
->hash
);
6216 fprintf (stderr
, "charset: %d\n", face
->charset
);
6220 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6228 fprintf (stderr
, "font selection order: ");
6229 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6230 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6231 fprintf (stderr
, "\n");
6233 fprintf (stderr
, "alternative fonts: ");
6234 debug_print (Vface_alternative_font_family_alist
);
6235 fprintf (stderr
, "\n");
6237 for (i
= 0; i
< FRAME_FACE_CACHE (selected_frame
)->used
; ++i
)
6238 Fdump_face (make_number (i
));
6243 CHECK_NUMBER (n
, 0);
6244 face
= FACE_FROM_ID (selected_frame
, XINT (n
));
6246 error ("Not a valid face");
6247 dump_realized_face (face
);
6254 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6258 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6259 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6260 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6264 #endif /* GLYPH_DEBUG != 0 */
6268 /***********************************************************************
6270 ***********************************************************************/
6275 Qface
= intern ("face");
6277 Qpixmap_spec_p
= intern ("pixmap-spec-p");
6278 staticpro (&Qpixmap_spec_p
);
6279 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6280 staticpro (&Qframe_update_face_colors
);
6282 /* Lisp face attribute keywords. */
6283 QCfamily
= intern (":family");
6284 staticpro (&QCfamily
);
6285 QCheight
= intern (":height");
6286 staticpro (&QCheight
);
6287 QCweight
= intern (":weight");
6288 staticpro (&QCweight
);
6289 QCslant
= intern (":slant");
6290 staticpro (&QCslant
);
6291 QCunderline
= intern (":underline");
6292 staticpro (&QCunderline
);
6293 QCinverse_video
= intern (":inverse-video");
6294 staticpro (&QCinverse_video
);
6295 QCreverse_video
= intern (":reverse-video");
6296 staticpro (&QCreverse_video
);
6297 QCforeground
= intern (":foreground");
6298 staticpro (&QCforeground
);
6299 QCbackground
= intern (":background");
6300 staticpro (&QCbackground
);
6301 QCstipple
= intern (":stipple");;
6302 staticpro (&QCstipple
);
6303 QCwidth
= intern (":width");
6304 staticpro (&QCwidth
);
6305 QCfont
= intern (":font");
6306 staticpro (&QCfont
);
6307 QCbold
= intern (":bold");
6308 staticpro (&QCbold
);
6309 QCitalic
= intern (":italic");
6310 staticpro (&QCitalic
);
6311 QCoverline
= intern (":overline");
6312 staticpro (&QCoverline
);
6313 QCstrike_through
= intern (":strike-through");
6314 staticpro (&QCstrike_through
);
6315 QCbox
= intern (":box");
6318 /* Symbols used for Lisp face attribute values. */
6319 QCcolor
= intern (":color");
6320 staticpro (&QCcolor
);
6321 QCline_width
= intern (":line-width");
6322 staticpro (&QCline_width
);
6323 QCstyle
= intern (":style");
6324 staticpro (&QCstyle
);
6325 Qreleased_button
= intern ("released-button");
6326 staticpro (&Qreleased_button
);
6327 Qpressed_button
= intern ("pressed-button");
6328 staticpro (&Qpressed_button
);
6329 Qnormal
= intern ("normal");
6330 staticpro (&Qnormal
);
6331 Qultra_light
= intern ("ultra-light");
6332 staticpro (&Qultra_light
);
6333 Qextra_light
= intern ("extra-light");
6334 staticpro (&Qextra_light
);
6335 Qlight
= intern ("light");
6336 staticpro (&Qlight
);
6337 Qsemi_light
= intern ("semi-light");
6338 staticpro (&Qsemi_light
);
6339 Qsemi_bold
= intern ("semi-bold");
6340 staticpro (&Qsemi_bold
);
6341 Qbold
= intern ("bold");
6343 Qextra_bold
= intern ("extra-bold");
6344 staticpro (&Qextra_bold
);
6345 Qultra_bold
= intern ("ultra-bold");
6346 staticpro (&Qultra_bold
);
6347 Qoblique
= intern ("oblique");
6348 staticpro (&Qoblique
);
6349 Qitalic
= intern ("italic");
6350 staticpro (&Qitalic
);
6351 Qreverse_oblique
= intern ("reverse-oblique");
6352 staticpro (&Qreverse_oblique
);
6353 Qreverse_italic
= intern ("reverse-italic");
6354 staticpro (&Qreverse_italic
);
6355 Qultra_condensed
= intern ("ultra-condensed");
6356 staticpro (&Qultra_condensed
);
6357 Qextra_condensed
= intern ("extra-condensed");
6358 staticpro (&Qextra_condensed
);
6359 Qcondensed
= intern ("condensed");
6360 staticpro (&Qcondensed
);
6361 Qsemi_condensed
= intern ("semi-condensed");
6362 staticpro (&Qsemi_condensed
);
6363 Qsemi_expanded
= intern ("semi-expanded");
6364 staticpro (&Qsemi_expanded
);
6365 Qexpanded
= intern ("expanded");
6366 staticpro (&Qexpanded
);
6367 Qextra_expanded
= intern ("extra-expanded");
6368 staticpro (&Qextra_expanded
);
6369 Qultra_expanded
= intern ("ultra-expanded");
6370 staticpro (&Qultra_expanded
);
6371 Qbackground_color
= intern ("background-color");
6372 staticpro (&Qbackground_color
);
6373 Qforeground_color
= intern ("foreground-color");
6374 staticpro (&Qforeground_color
);
6375 Qunspecified
= intern ("unspecified");
6376 staticpro (&Qunspecified
);
6378 Qx_charset_registry
= intern ("x-charset-registry");
6379 staticpro (&Qx_charset_registry
);
6380 Qface_alias
= intern ("face-alias");
6381 staticpro (&Qface_alias
);
6382 Qdefault
= intern ("default");
6383 staticpro (&Qdefault
);
6384 Qmode_line
= intern ("mode-line");
6385 staticpro (&Qmode_line
);
6386 Qtool_bar
= intern ("tool-bar");
6387 staticpro (&Qtool_bar
);
6388 Qregion
= intern ("region");
6389 staticpro (&Qregion
);
6390 Qfringe
= intern ("fringe");
6391 staticpro (&Qfringe
);
6392 Qheader_line
= intern ("header-line");
6393 staticpro (&Qheader_line
);
6394 Qscroll_bar
= intern ("scroll-bar");
6395 staticpro (&Qscroll_bar
);
6396 Qcursor
= intern ("cursor");
6397 staticpro (&Qcursor
);
6398 Qborder
= intern ("border");
6399 staticpro (&Qborder
);
6400 Qmouse
= intern ("mouse");
6401 staticpro (&Qmouse
);
6403 defsubr (&Sinternal_make_lisp_face
);
6404 defsubr (&Sinternal_lisp_face_p
);
6405 defsubr (&Sinternal_set_lisp_face_attribute
);
6406 #ifdef HAVE_X_WINDOWS
6407 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6408 defsubr (&Sface_color_gray_p
);
6409 defsubr (&Sface_color_supported_p
);
6411 defsubr (&Sinternal_get_lisp_face_attribute
);
6412 defsubr (&Sinternal_lisp_face_attribute_values
);
6413 defsubr (&Sinternal_lisp_face_equal_p
);
6414 defsubr (&Sinternal_lisp_face_empty_p
);
6415 defsubr (&Sinternal_copy_lisp_face
);
6416 defsubr (&Sinternal_merge_in_global_face
);
6417 defsubr (&Sface_font
);
6418 defsubr (&Sframe_face_alist
);
6419 defsubr (&Sinternal_set_font_selection_order
);
6420 defsubr (&Sinternal_set_alternative_font_family_alist
);
6422 defsubr (&Sdump_face
);
6423 defsubr (&Sshow_face_resources
);
6424 #endif /* GLYPH_DEBUG */
6425 defsubr (&Sclear_face_cache
);
6427 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6428 "*Limit for font matching.\n\
6429 If an integer > 0, font matching functions won't load more than\n\
6430 that number of fonts when searching for a matching font.");
6431 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6433 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6434 "List of global face definitions (for internal use only.)");
6435 Vface_new_frame_defaults
= Qnil
;
6437 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6438 "*Default stipple pattern used on monochrome displays.\n\
6439 This stipple pattern is used on monochrome displays\n\
6440 instead of shades of gray for a face background color.\n\
6441 See `set-face-stipple' for possible values for this variable.");
6442 Vface_default_stipple
= build_string ("gray3");
6444 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6445 "Default registry and encoding to use.\n\
6446 This registry and encoding is used for unibyte text. It is set up\n\
6447 from the specified frame font when Emacs starts. (For internal use only.)");
6448 Vface_default_registry
= Qnil
;
6450 DEFVAR_LISP ("face-alternative-font-family-alist",
6451 &Vface_alternative_font_family_alist
, "");
6452 Vface_alternative_font_family_alist
= Qnil
;
6456 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6457 "Allowed scalable fonts.\n\
6458 A value of nil means don't allow any scalable fonts.\n\
6459 A value of t means allow any scalable font.\n\
6460 Otherwise, value must be a list of regular expressions. A font may be\n\
6461 scaled if its name matches a regular expression in the list.");
6462 Vscalable_fonts_allowed
= Qnil
;
6464 #endif /* SCALABLE_FONTS */
6466 #ifdef HAVE_X_WINDOWS
6467 defsubr (&Spixmap_spec_p
);
6468 defsubr (&Sx_list_fonts
);
6469 defsubr (&Sinternal_face_x_get_resource
);
6470 defsubr (&Sx_family_fonts
);
6471 defsubr (&Sx_font_family_list
);
6472 #endif /* HAVE_X_WINDOWS */
6474 /* TTY face support. */
6475 defsubr (&Sface_register_tty_color
);
6476 defsubr (&Sface_clear_tty_colors
);
6477 defsubr (&Stty_defined_colors
);
6478 Vface_tty_color_alist
= Qnil
;
6479 staticpro (&Vface_tty_color_alist
);