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 /* Names of basic faces. */
283 Lisp_Object Qdefault
, Qmodeline
, Qtoolbar
, Qregion
, Qbitmap_area
;
284 Lisp_Object Qtop_line
;
286 /* Default stipple pattern used on monochrome displays. This stipple
287 pattern is used on monochrome displays instead of shades of gray
288 for a face background color. See `set-face-stipple' for possible
289 values for this variable. */
291 Lisp_Object Vface_default_stipple
;
293 /* Default registry and encoding to use for charsets whose charset
294 symbols don't specify one. */
296 Lisp_Object Vface_default_registry
;
298 /* Alist of alternative font families. Each element is of the form
299 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
300 try FAMILY1, then FAMILY2, ... */
302 Lisp_Object Vface_alternative_font_family_alist
;
304 /* Allowed scalable fonts. A value of nil means don't allow any
305 scalable fonts. A value of t means allow the use of any scalable
306 font. Otherwise, value must be a list of regular expressions. A
307 font may be scaled if its name matches a regular expression in the
311 Lisp_Object Vscalable_fonts_allowed
;
314 /* Maximum number of fonts to consider in font_list. If not an
315 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
317 Lisp_Object Vfont_list_limit
;
318 #define DEFAULT_FONT_LIST_LIMIT 100
320 /* The symbols `foreground-color' and `background-color' which can be
321 used as part of a `face' property. This is for compatibility with
324 Lisp_Object Qforeground_color
, Qbackground_color
;
326 /* The symbols `face' and `mouse-face' used as text properties. */
329 extern Lisp_Object Qmouse_face
;
331 /* Error symbol for wrong_type_argument in load_pixmap. */
333 Lisp_Object Qpixmap_spec_p
;
335 /* Alist of global face definitions. Each element is of the form
336 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
337 is a Lisp vector of face attributes. These faces are used
338 to initialize faces for new frames. */
340 Lisp_Object Vface_new_frame_defaults
;
342 /* The next ID to assign to Lisp faces. */
344 static int next_lface_id
;
346 /* A vector mapping Lisp face Id's to face names. */
348 static Lisp_Object
*lface_id_to_name
;
349 static int lface_id_to_name_size
;
351 /* An alist of elements (COLOR-NAME . INDEX) mapping color names
352 to color indices for tty frames. */
354 Lisp_Object Vface_tty_color_alist
;
356 /* Counter for calls to clear_face_cache. If this counter reaches
357 CLEAR_FONT_TABLE_COUNT, and a frame has more than
358 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
360 static int clear_font_table_count
;
361 #define CLEAR_FONT_TABLE_COUNT 100
362 #define CLEAR_FONT_TABLE_NFONTS 10
364 /* Non-zero means face attributes have been changed since the last
365 redisplay. Used in redisplay_internal. */
367 int face_change_count
;
369 /* The total number of colors currently allocated. */
372 static int ncolors_allocated
;
373 static int npixmaps_allocated
;
379 /* Function prototypes. */
384 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
385 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
386 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
388 static int first_font_matching
P_ ((struct frame
*f
, char *,
389 struct font_name
*));
390 static int x_face_list_fonts
P_ ((struct frame
*, char *,
391 struct font_name
*, int, int, int));
392 static int font_scalable_p
P_ ((struct font_name
*));
393 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
394 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
395 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
396 static char *xstrdup
P_ ((char *));
397 static unsigned char *xstrlwr
P_ ((unsigned char *));
398 static void signal_error
P_ ((char *, Lisp_Object
));
399 static void add_to_log
P_ ((struct frame
*, char *, Lisp_Object
, Lisp_Object
));
400 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
401 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
402 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
403 static void free_face_colors
P_ ((struct frame
*, struct face
*));
404 static int face_color_gray_p
P_ ((struct frame
*, char *));
405 static char *build_font_name
P_ ((struct font_name
*));
406 static void free_font_names
P_ ((struct font_name
*, int));
407 static int sorted_font_list
P_ ((struct frame
*, char *,
408 int (*cmpfn
) P_ ((const void *, const void *)),
409 struct font_name
**));
410 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
411 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
412 struct font_name
**));
413 static int cmp_font_names
P_ ((const void *, const void *));
414 static struct face
*realize_face
P_ ((struct face_cache
*,
415 Lisp_Object
*, int));
416 static struct face
*realize_x_face
P_ ((struct face_cache
*,
417 Lisp_Object
*, int));
418 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
419 Lisp_Object
*, int));
420 static int realize_basic_faces
P_ ((struct frame
*));
421 static int realize_default_face
P_ ((struct frame
*));
422 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
423 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
424 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
425 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
426 static unsigned lface_hash
P_ ((Lisp_Object
*));
427 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
428 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
429 static void free_realized_face
P_ ((struct frame
*, struct face
*));
430 static void clear_face_gcs
P_ ((struct face_cache
*));
431 static void free_face_cache
P_ ((struct face_cache
*));
432 static int face_numeric_weight
P_ ((Lisp_Object
));
433 static int face_numeric_slant
P_ ((Lisp_Object
));
434 static int face_numeric_swidth
P_ ((Lisp_Object
));
435 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
436 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
438 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
440 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
441 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
443 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
445 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
446 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
447 static void free_realized_faces
P_ ((struct face_cache
*));
448 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
449 struct font_name
*, int));
450 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
451 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
452 static int xlfd_numeric_slant
P_ ((struct font_name
*));
453 static int xlfd_numeric_weight
P_ ((struct font_name
*));
454 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
455 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
456 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
457 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
458 static int xlfd_fixed_p
P_ ((struct font_name
*));
459 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
461 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
462 struct font_name
*, int, int));
463 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
464 struct font_name
*, int));
466 #ifdef HAVE_X_WINDOWS
468 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
469 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
470 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
471 int (*cmpfn
) P_ ((const void *, const void *))));
472 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
473 static void x_free_gc
P_ ((struct frame
*, GC
));
474 static void clear_font_table
P_ ((struct frame
*));
476 #endif /* HAVE_X_WINDOWS */
479 /***********************************************************************
481 ***********************************************************************/
483 #ifdef HAVE_X_WINDOWS
485 /* Create and return a GC for use on frame F. GC values and mask
486 are given by XGCV and MASK. */
489 x_create_gc (f
, mask
, xgcv
)
496 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
503 /* Free GC which was used on frame F. */
511 xassert (--ngcs
>= 0);
512 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
516 #endif /* HAVE_X_WINDOWS */
519 /* Like strdup, but uses xmalloc. */
525 int len
= strlen (s
) + 1;
526 char *p
= (char *) xmalloc (len
);
532 /* Like stricmp. Used to compare parts of font names which are in
537 unsigned char *s1
, *s2
;
541 unsigned char c1
= tolower (*s1
);
542 unsigned char c2
= tolower (*s2
);
544 return c1
< c2
? -1 : 1;
549 return *s2
== 0 ? 0 : -1;
554 /* Like strlwr, which might not always be available. */
556 static unsigned char *
560 unsigned char *p
= s
;
569 /* Signal `error' with message S, and additional argument ARG. */
572 signal_error (s
, arg
)
576 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
580 /* Display a message with format string FORMAT and arguments ARG1 and
581 ARG2 on frame F. Used to display errors if fonts, bitmaps, colors
582 etc. for a realized face on frame F cannot be loaded. (If we would
583 signal an error in these cases, we would end up in an infinite
584 recursion because this would stop realization, and the redisplay
585 triggered by the signal would try to realize that same face again.)
587 If basic faces of F are not realized, just add the message to the
588 messages buffer "*Messages*". Because Fmessage calls
589 echo_area_display which tries to realize basic faces again, we would
590 otherwise also end in an infinite recursion. */
593 add_to_log (f
, format
, arg1
, arg2
)
596 Lisp_Object arg1
, arg2
;
602 extern int waiting_for_input
;
604 /* Function note_mouse_highlight calls face_at_buffer_position which
605 may realize a face. If some attribute of that face is invalid,
606 say an invalid color, don't display an error to avoid calling
607 Lisp from XTread_socket. */
608 if (waiting_for_input
)
611 nargs
= make_number (DIM (args
));
612 args
[0] = build_string (format
);
615 msg
= Fformat (nargs
, args
);
617 /* Log the error, but don't display it in the echo area. This
618 proves to be annoying in many cases. */
619 buffer
= LSTRDUPA (msg
);
620 message_dolog (buffer
, strlen (buffer
), 1, 0);
624 /* If FRAME is nil, return selected_frame. Otherwise, check that
625 FRAME is a live frame, and return a pointer to it. NPARAM
626 is the parameter number of FRAME, for CHECK_LIVE_FRAME. This is
627 here because it's a frequent pattern in Lisp function definitions. */
629 static INLINE
struct frame
*
630 frame_or_selected_frame (frame
, nparam
)
640 CHECK_LIVE_FRAME (frame
, nparam
);
648 /***********************************************************************
650 ***********************************************************************/
652 /* Initialize face cache and basic faces for frame F. */
658 /* Make a face cache, if F doesn't have one. */
659 if (FRAME_FACE_CACHE (f
) == NULL
)
660 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
662 #ifdef HAVE_X_WINDOWS
663 /* Make the image cache. */
666 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
667 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
668 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
670 #endif /* HAVE_X_WINDOWS */
672 /* Realize basic faces. Must have enough information in frame
673 parameters to realize basic faces at this point. */
674 #ifdef HAVE_X_WINDOWS
675 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
677 if (!realize_basic_faces (f
))
682 /* Free face cache of frame F. Called from Fdelete_frame. */
688 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
692 free_face_cache (face_cache
);
693 FRAME_FACE_CACHE (f
) = NULL
;
696 #ifdef HAVE_X_WINDOWS
699 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
702 --image_cache
->refcount
;
703 if (image_cache
->refcount
== 0)
704 free_image_cache (f
);
707 #endif /* HAVE_X_WINDOWS */
711 /* Recompute basic faces for frame F. Call this after changing frame
712 parameters on which those faces depend, or when realized faces have
713 been freed due to changing attributes of named faces. */
716 recompute_basic_faces (f
)
719 if (FRAME_FACE_CACHE (f
))
721 int realized_p
= realize_basic_faces (f
);
722 xassert (realized_p
);
727 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
728 try to free unused fonts, too. */
731 clear_face_cache (clear_fonts_p
)
734 #ifdef HAVE_X_WINDOWS
735 Lisp_Object tail
, frame
;
739 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
741 /* From time to time see if we can unload some fonts. This also
742 frees all realized faces on all frames. Fonts needed by
743 faces will be loaded again when faces are realized again. */
744 clear_font_table_count
= 0;
746 FOR_EACH_FRAME (tail
, frame
)
750 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
752 free_all_realized_faces (frame
);
753 clear_font_table (f
);
759 /* Clear GCs of realized faces. */
760 FOR_EACH_FRAME (tail
, frame
)
765 clear_face_gcs (FRAME_FACE_CACHE (f
));
766 clear_image_cache (f
, 0);
770 #endif /* HAVE_X_WINDOWS */
774 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
775 "Clear face caches on all frames.\n\
776 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
778 Lisp_Object thorougly
;
780 clear_face_cache (!NILP (thorougly
));
786 #ifdef HAVE_X_WINDOWS
789 /* Remove those fonts from the font table of frame F that are not used
790 by fontsets. Called from clear_face_cache from time to time. */
796 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
798 Lisp_Object rest
, frame
;
801 xassert (FRAME_X_P (f
));
803 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
804 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
806 /* For all frames with the same x_display_info as F, record
807 in `used' those fonts that are in use by fontsets. */
808 FOR_EACH_FRAME (rest
, frame
)
809 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
811 struct frame
*f
= XFRAME (frame
);
812 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
814 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
816 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
819 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
821 int idx
= info
->font_indexes
[j
];
828 /* Free those fonts that are not used by fontsets. */
829 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
830 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
832 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
834 /* Free names. In xfns.c there is a comment that full_name
835 should never be freed because it is always shared with
836 something else. I don't think this is true anymore---see
837 x_load_font. It's either equal to font_info->name or
838 allocated via xmalloc, and there seems to be no place in
839 the source files where full_name is transferred to another
841 if (font_info
->full_name
!= font_info
->name
)
842 xfree (font_info
->full_name
);
843 xfree (font_info
->name
);
847 XFreeFont (dpyinfo
->display
, font_info
->font
);
850 /* Mark font table slot free. */
851 font_info
->font
= NULL
;
852 font_info
->name
= font_info
->full_name
= NULL
;
857 #endif /* HAVE_X_WINDOWS */
861 /***********************************************************************
863 ***********************************************************************/
865 #ifdef HAVE_X_WINDOWS
867 DEFUN ("pixmap-spec-p", Fpixmap_spec_p
, Spixmap_spec_p
, 1, 1, 0,
868 "Non-nil if OBJECT is a valid pixmap specification.\n\
869 A pixmap specification is either a string, or a list (WIDTH HEIGHT DATA)\n\
870 where WIDTH is the pixel width of the pixmap, HEIGHT is its height,\n\
871 and DATA contains the bits of the pixmap.")
875 Lisp_Object height
, width
;
877 return ((STRINGP (object
)
879 && CONSP (XCONS (object
)->cdr
)
880 && CONSP (XCONS (XCONS (object
)->cdr
)->cdr
)
881 && NILP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->cdr
)
882 && (width
= XCONS (object
)->car
, INTEGERP (width
))
883 && (height
= XCONS (XCONS (object
)->cdr
)->car
,
885 && STRINGP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)
888 /* The string must have enough bits for width * height. */
889 && ((XSTRING (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)->size
890 * (BITS_PER_INT
/ sizeof (int)))
891 >= XFASTINT (width
) * XFASTINT (height
))))
896 /* Load a bitmap according to NAME (which is either a file name or a
897 pixmap spec) for use on frame F. Value is the bitmap_id (see
898 xfns.c). If NAME is nil, return with a bitmap id of zero. If
899 bitmap cannot be loaded, display a message saying so, and return
900 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
901 if these pointers are not null. */
904 load_pixmap (f
, name
, w_ptr
, h_ptr
)
907 unsigned int *w_ptr
, *h_ptr
;
915 tem
= Fpixmap_spec_p (name
);
917 wrong_type_argument (Qpixmap_spec_p
, name
);
922 /* Decode a bitmap spec into a bitmap. */
927 w
= XINT (Fcar (name
));
928 h
= XINT (Fcar (Fcdr (name
)));
929 bits
= Fcar (Fcdr (Fcdr (name
)));
931 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
936 /* It must be a string -- a file name. */
937 bitmap_id
= x_create_bitmap_from_file (f
, name
);
943 add_to_log (f
, "Invalid or undefined bitmap %s", name
, Qnil
);
954 ++npixmaps_allocated
;
957 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
960 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
966 #endif /* HAVE_X_WINDOWS */
970 /***********************************************************************
972 ***********************************************************************/
974 #ifdef HAVE_X_WINDOWS
976 /* Update the line_height of frame F. Return non-zero if line height
980 frame_update_line_height (f
)
983 int fontset
, line_height
, changed_p
;
985 fontset
= f
->output_data
.x
->fontset
;
987 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
989 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
991 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
992 f
->output_data
.x
->line_height
= line_height
;
996 #endif /* HAVE_X_WINDOWS */
999 /***********************************************************************
1001 ***********************************************************************/
1003 #ifdef HAVE_X_WINDOWS
1005 /* Load font or fontset of face FACE which is used on frame F.
1006 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1007 fontset. FONT_NAME is the name of the font to load, if no fontset
1008 is used. It is null if no suitable font name could be determined
1012 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1018 struct font_info
*font_info
= NULL
;
1020 face
->font_info_id
= -1;
1021 face
->fontset
= fontset
;
1026 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1029 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1038 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1039 face
->font
= font_info
->font
;
1040 face
->font_name
= font_info
->full_name
;
1042 /* Make the registry part of the font name readily accessible.
1043 The registry is used to find suitable faces for unibyte text. */
1044 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1046 while (i
< 2 && --s
>= font_info
->full_name
)
1050 if (!STRINGP (face
->registry
)
1051 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1053 if (STRINGP (Vface_default_registry
)
1054 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1055 face
->registry
= Vface_default_registry
;
1057 face
->registry
= build_string (s
+ 1);
1060 else if (fontset
>= 0)
1061 add_to_log (f
, "Unable to load ASCII font of fontset %d",
1062 make_number (fontset
), Qnil
);
1064 add_to_log (f
, "Unable to load font %s",
1065 build_string (font_name
), Qnil
);
1068 #endif /* HAVE_X_WINDOWS */
1072 /***********************************************************************
1074 ***********************************************************************/
1076 #ifdef HAVE_X_WINDOWS
1078 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1079 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1082 face_color_gray_p (f
, color_name
)
1089 if (defined_color (f
, color_name
, &color
, 0))
1090 gray_p
= ((abs (color
.red
- color
.green
)
1091 < max (color
.red
, color
.green
) / 20)
1092 && (abs (color
.green
- color
.blue
)
1093 < max (color
.green
, color
.blue
) / 20)
1094 && (abs (color
.blue
- color
.red
)
1095 < max (color
.blue
, color
.red
) / 20));
1103 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1104 BACKGROUND_P non-zero means the color will be used as background
1108 face_color_supported_p (f
, color_name
, background_p
)
1115 XSETFRAME (frame
, f
);
1116 return (!NILP (Vwindow_system
)
1117 && (!NILP (Fx_display_color_p (frame
))
1118 || xstricmp (color_name
, "black") == 0
1119 || xstricmp (color_name
, "white") == 0
1121 && face_color_gray_p (f
, color_name
))
1122 || (!NILP (Fx_display_grayscale_p (frame
))
1123 && face_color_gray_p (f
, color_name
))));
1127 DEFUN ("face-color-gray-p", Fface_color_gray_p
, Sface_color_gray_p
, 1, 2, 0,
1128 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1129 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1130 If FRAME is nil or omitted, use the selected frame.")
1132 Lisp_Object color
, frame
;
1134 struct frame
*f
= check_x_frame (frame
);
1135 CHECK_STRING (color
, 0);
1136 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1140 DEFUN ("face-color-supported-p", Fface_color_supported_p
,
1141 Sface_color_supported_p
, 2, 3, 0,
1142 "Return non-nil if COLOR can be displayed on FRAME.\n\
1143 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1144 If FRAME is nil or omitted, use the selected frame.\n\
1145 COLOR must be a valid color name.")
1146 (frame
, color
, background_p
)
1147 Lisp_Object frame
, color
, background_p
;
1149 struct frame
*f
= check_x_frame (frame
);
1150 CHECK_STRING (color
, 0);
1151 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1156 /* Load color with name NAME for use by face FACE on frame F.
1157 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1158 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1159 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1160 pixel color. If color cannot be loaded, display a message, and
1161 return the foreground, background or underline color of F, but
1162 record that fact in flags of the face so that we don't try to free
1166 load_color (f
, face
, name
, target_index
)
1170 enum lface_attribute_index target_index
;
1174 xassert (STRINGP (name
));
1175 xassert (target_index
== LFACE_FOREGROUND_INDEX
1176 || target_index
== LFACE_BACKGROUND_INDEX
1177 || target_index
== LFACE_UNDERLINE_INDEX
1178 || target_index
== LFACE_OVERLINE_INDEX
1179 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1180 || target_index
== LFACE_BOX_INDEX
);
1182 /* if the color map is full, defined_color will return a best match
1183 to the values in an existing cell. */
1184 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1186 add_to_log (f
, "Unable to load color %s", name
, Qnil
);
1188 switch (target_index
)
1190 case LFACE_FOREGROUND_INDEX
:
1191 face
->foreground_defaulted_p
= 1;
1192 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1195 case LFACE_BACKGROUND_INDEX
:
1196 face
->background_defaulted_p
= 1;
1197 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1200 case LFACE_UNDERLINE_INDEX
:
1201 face
->underline_defaulted_p
= 1;
1202 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1205 case LFACE_OVERLINE_INDEX
:
1206 face
->overline_color_defaulted_p
= 1;
1207 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1210 case LFACE_STRIKE_THROUGH_INDEX
:
1211 face
->strike_through_color_defaulted_p
= 1;
1212 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1215 case LFACE_BOX_INDEX
:
1216 face
->box_color_defaulted_p
= 1;
1217 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1226 ++ncolors_allocated
;
1233 /* Load colors for face FACE which is used on frame F. Colors are
1234 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1235 of ATTRS. If the background color specified is not supported on F,
1236 try to emulate gray colors with a stipple from Vface_default_stipple. */
1239 load_face_colors (f
, face
, attrs
)
1246 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1247 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1249 /* Swap colors if face is inverse-video. */
1250 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1258 /* Check for support for foreground, not for background because
1259 face_color_supported_p is smart enough to know that grays are
1260 "supported" as background because we are supposed to use stipple
1262 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1263 && !NILP (Fpixmap_spec_p (Vface_default_stipple
)))
1265 x_destroy_bitmap (f
, face
->stipple
);
1266 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1267 &face
->pixmap_w
, &face
->pixmap_h
);
1270 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1271 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1275 /* Free color PIXEL on frame F. */
1278 unload_color (f
, pixel
)
1280 unsigned long pixel
;
1282 Display
*dpy
= FRAME_X_DISPLAY (f
);
1283 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1285 if (pixel
== BLACK_PIX_DEFAULT (f
)
1286 || pixel
== WHITE_PIX_DEFAULT (f
))
1291 /* If display has an immutable color map, freeing colors is not
1292 necessary and some servers don't allow it. So don't do it. */
1293 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1295 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1296 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1303 /* Free colors allocated for FACE. */
1306 free_face_colors (f
, face
)
1310 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1312 /* If display has an immutable color map, freeing colors is not
1313 necessary and some servers don't allow it. So don't do it. */
1314 if (class != StaticColor
1315 && class != StaticGray
1316 && class != TrueColor
)
1322 dpy
= FRAME_X_DISPLAY (f
);
1323 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1325 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1326 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1327 && !face
->foreground_defaulted_p
)
1329 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1330 IF_DEBUG (--ncolors_allocated
);
1333 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1334 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1335 && !face
->background_defaulted_p
)
1337 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1338 IF_DEBUG (--ncolors_allocated
);
1341 if (face
->underline_p
1342 && !face
->underline_defaulted_p
1343 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1344 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1346 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1347 IF_DEBUG (--ncolors_allocated
);
1350 if (face
->overline_p
1351 && !face
->overline_color_defaulted_p
1352 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1353 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1355 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1356 IF_DEBUG (--ncolors_allocated
);
1359 if (face
->strike_through_p
1360 && !face
->strike_through_color_defaulted_p
1361 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1362 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1364 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1365 IF_DEBUG (--ncolors_allocated
);
1368 if (face
->box
!= FACE_NO_BOX
1369 && !face
->box_color_defaulted_p
1370 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1371 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1373 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1374 IF_DEBUG (--ncolors_allocated
);
1381 #else /* ! HAVE_X_WINDOWS */
1385 load_color (f
, face
, name
, target_index
)
1389 enum lface_attribute_index target_index
;
1392 int color_idx
= FACE_TTY_DEFAULT_COLOR
;
1395 return (unsigned long)FACE_TTY_DEFAULT_COLOR
;
1397 CHECK_STRING (name
, 0);
1400 if (XSTRING (name
)->size
&& !NILP (Ffboundp (Qmsdos_color_translate
)))
1402 color
= call1 (Qmsdos_color_translate
, name
);
1404 if (INTEGERP (color
))
1405 return (unsigned long)XINT (color
);
1407 add_to_log (f
, "Unable to load color %s", name
, Qnil
);
1409 switch (target_index
)
1411 case LFACE_FOREGROUND_INDEX
:
1412 face
->foreground_defaulted_p
= 1;
1413 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1416 case LFACE_BACKGROUND_INDEX
:
1417 face
->background_defaulted_p
= 1;
1418 color_idx
= FRAME_BACKGROUND_PIXEL (f
);
1421 case LFACE_UNDERLINE_INDEX
:
1422 face
->underline_defaulted_p
= 1;
1423 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1426 case LFACE_OVERLINE_INDEX
:
1427 face
->overline_color_defaulted_p
= 1;
1428 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1431 case LFACE_STRIKE_THROUGH_INDEX
:
1432 face
->strike_through_color_defaulted_p
= 1;
1433 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1436 case LFACE_BOX_INDEX
:
1437 face
->box_color_defaulted_p
= 1;
1438 color_idx
= FRAME_FOREGROUND_PIXEL (f
);
1443 color_idx
= msdos_stdcolor_idx (XSTRING (name
)->data
);
1445 return (unsigned long)color_idx
;
1448 #endif /* ! HAVE_X_WINDOWS */
1452 /***********************************************************************
1454 ***********************************************************************/
1456 /* An enumerator for each field of an XLFD font name. */
1477 /* An enumerator for each possible slant value of a font. Taken from
1478 the XLFD specification. */
1486 XLFD_SLANT_REVERSE_ITALIC
,
1487 XLFD_SLANT_REVERSE_OBLIQUE
,
1491 /* Relative font weight according to XLFD documentation. */
1495 XLFD_WEIGHT_UNKNOWN
,
1496 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1497 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1498 XLFD_WEIGHT_LIGHT
, /* 30 */
1499 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1500 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1501 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1502 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1503 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1504 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1507 /* Relative proportionate width. */
1511 XLFD_SWIDTH_UNKNOWN
,
1512 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1513 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1514 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1515 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1516 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1517 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1518 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1519 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1520 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1523 /* Structure used for tables mapping XLFD weight, slant, and width
1524 names to numeric and symbolic values. */
1530 Lisp_Object
*symbol
;
1533 /* Table of XLFD slant names and their numeric and symbolic
1534 representations. This table must be sorted by slant names in
1537 static struct table_entry slant_table
[] =
1539 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1540 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1541 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1542 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1543 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1544 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1547 /* Table of XLFD weight names. This table must be sorted by weight
1548 names in ascending order. */
1550 static struct table_entry weight_table
[] =
1552 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1553 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1554 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1555 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1556 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1557 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1558 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1559 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1560 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1561 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1562 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1563 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1564 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1565 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1566 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1569 /* Table of XLFD width names. This table must be sorted by width
1570 names in ascending order. */
1572 static struct table_entry swidth_table
[] =
1574 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1575 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1576 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1577 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1578 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1579 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1580 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1581 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1582 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1583 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1584 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1585 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1586 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1587 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1588 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1591 /* Structure used to hold the result of splitting font names in XLFD
1592 format into their fields. */
1596 /* The original name which is modified destructively by
1597 split_font_name. The pointer is kept here to be able to free it
1598 if it was allocated from the heap. */
1601 /* Font name fields. Each vector element points into `name' above.
1602 Fields are NUL-terminated. */
1603 char *fields
[XLFD_LAST
];
1605 /* Numeric values for those fields that interest us. See
1606 split_font_name for which these are. */
1607 int numeric
[XLFD_LAST
];
1610 /* The frame in effect when sorting font names. Set temporarily in
1611 sort_fonts so that it is available in font comparison functions. */
1613 static struct frame
*font_frame
;
1615 /* Order by which font selection chooses fonts. The default values
1616 mean `first, find a best match for the font width, then for the
1617 font height, then for weight, then for slant.' This variable can be
1618 set via set-face-font-sort-order. */
1620 static int font_sort_order
[4];
1623 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1624 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1625 is a pointer to the matching table entry or null if no table entry
1628 static struct table_entry
*
1629 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1630 struct table_entry
*table
;
1632 struct font_name
*font
;
1635 /* Function split_font_name converts fields to lower-case, so there
1636 is no need to use xstrlwr or xstricmp here. */
1637 char *s
= font
->fields
[field_index
];
1638 int low
, mid
, high
, cmp
;
1645 mid
= (low
+ high
) / 2;
1646 cmp
= strcmp (table
[mid
].name
, s
);
1660 /* Return a numeric representation for font name field
1661 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1662 has DIM entries. Value is the numeric value found or DFLT if no
1663 table entry matches. This function is used to translate weight,
1664 slant, and swidth names of XLFD font names to numeric values. */
1667 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1668 struct table_entry
*table
;
1670 struct font_name
*font
;
1674 struct table_entry
*p
;
1675 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1676 return p
? p
->numeric
: dflt
;
1680 /* Return a symbolic representation for font name field
1681 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1682 has DIM entries. Value is the symbolic value found or DFLT if no
1683 table entry matches. This function is used to translate weight,
1684 slant, and swidth names of XLFD font names to symbols. */
1686 static INLINE Lisp_Object
1687 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1688 struct table_entry
*table
;
1690 struct font_name
*font
;
1694 struct table_entry
*p
;
1695 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1696 return p
? *p
->symbol
: dflt
;
1700 /* Return a numeric value for the slant of the font given by FONT. */
1703 xlfd_numeric_slant (font
)
1704 struct font_name
*font
;
1706 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1707 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1711 /* Return a symbol representing the weight of the font given by FONT. */
1713 static INLINE Lisp_Object
1714 xlfd_symbolic_slant (font
)
1715 struct font_name
*font
;
1717 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1718 font
, XLFD_SLANT
, Qnormal
);
1722 /* Return a numeric value for the weight of the font given by FONT. */
1725 xlfd_numeric_weight (font
)
1726 struct font_name
*font
;
1728 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1729 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1733 /* Return a symbol representing the slant of the font given by FONT. */
1735 static INLINE Lisp_Object
1736 xlfd_symbolic_weight (font
)
1737 struct font_name
*font
;
1739 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1740 font
, XLFD_WEIGHT
, Qnormal
);
1744 /* Return a numeric value for the swidth of the font whose XLFD font
1745 name fields are found in FONT. */
1748 xlfd_numeric_swidth (font
)
1749 struct font_name
*font
;
1751 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1752 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1756 /* Return a symbolic value for the swidth of FONT. */
1758 static INLINE Lisp_Object
1759 xlfd_symbolic_swidth (font
)
1760 struct font_name
*font
;
1762 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1763 font
, XLFD_SWIDTH
, Qnormal
);
1767 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1768 entries. Value is a pointer to the matching table entry or null if
1769 no element of TABLE contains SYMBOL. */
1771 static struct table_entry
*
1772 face_value (table
, dim
, symbol
)
1773 struct table_entry
*table
;
1779 xassert (SYMBOLP (symbol
));
1781 for (i
= 0; i
< dim
; ++i
)
1782 if (EQ (*table
[i
].symbol
, symbol
))
1785 return i
< dim
? table
+ i
: NULL
;
1789 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1790 entries. Value is -1 if SYMBOL is not found in TABLE. */
1793 face_numeric_value (table
, dim
, symbol
)
1794 struct table_entry
*table
;
1798 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1799 return p
? p
->numeric
: -1;
1803 /* Return a numeric value representing the weight specified by Lisp
1804 symbol WEIGHT. Value is one of the enumerators of enum
1808 face_numeric_weight (weight
)
1811 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1815 /* Return a numeric value representing the slant specified by Lisp
1816 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1819 face_numeric_slant (slant
)
1822 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1826 /* Return a numeric value representing the swidth specified by Lisp
1827 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1830 face_numeric_swidth (width
)
1833 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1837 #ifdef HAVE_X_WINDOWS
1839 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1843 struct font_name
*font
;
1845 /* Function split_font_name converts fields to lower-case, so there
1846 is no need to use tolower here. */
1847 return *font
->fields
[XLFD_SPACING
] != 'p';
1851 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1853 The actual height of the font when displayed on F depends on the
1854 resolution of both the font and frame. For example, a 10pt font
1855 designed for a 100dpi display will display larger than 10pt on a
1856 75dpi display. (It's not unusual to use fonts not designed for the
1857 display one is using. For example, some intlfonts are available in
1858 72dpi versions, only.)
1860 Value is the real point size of FONT on frame F, or 0 if it cannot
1864 xlfd_point_size (f
, font
)
1866 struct font_name
*font
;
1868 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1869 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1870 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1873 if (font_resy
== 0 || font_pt
== 0)
1876 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1882 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1883 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1884 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1885 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1886 zero if the font name doesn't have the format we expect. The
1887 expected format is a font name that starts with a `-' and has
1888 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1889 forms of font names where certain field contents are enclosed in
1890 square brackets. We don't support that, for now. */
1893 split_font_name (f
, font
, numeric_p
)
1895 struct font_name
*font
;
1901 if (*font
->name
== '-')
1903 char *p
= xstrlwr (font
->name
) + 1;
1905 while (i
< XLFD_LAST
)
1907 font
->fields
[i
] = p
;
1910 while (*p
&& *p
!= '-')
1920 success_p
= i
== XLFD_LAST
;
1922 /* If requested, and font name was in the expected format,
1923 compute numeric values for some fields. */
1924 if (numeric_p
&& success_p
)
1926 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1927 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1928 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1929 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1930 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
1937 /* Build an XLFD font name from font name fields in FONT. Value is a
1938 pointer to the font name, which is allocated via xmalloc. */
1941 build_font_name (font
)
1942 struct font_name
*font
;
1946 char *font_name
= (char *) xmalloc (size
);
1947 int total_length
= 0;
1949 for (i
= 0; i
< XLFD_LAST
; ++i
)
1951 /* Add 1 because of the leading `-'. */
1952 int len
= strlen (font
->fields
[i
]) + 1;
1954 /* Reallocate font_name if necessary. Add 1 for the final
1956 if (total_length
+ len
+ 1 >= size
)
1958 int new_size
= max (2 * size
, size
+ len
+ 1);
1959 int sz
= new_size
* sizeof *font_name
;
1960 font_name
= (char *) xrealloc (font_name
, sz
);
1964 font_name
[total_length
] = '-';
1965 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
1966 total_length
+= len
;
1969 font_name
[total_length
] = 0;
1974 /* Free an array FONTS of N font_name structures. This frees FONTS
1975 itself and all `name' fields in its elements. */
1978 free_font_names (fonts
, n
)
1979 struct font_name
*fonts
;
1983 xfree (fonts
[--n
].name
);
1988 /* Sort vector FONTS of font_name structures which contains NFONTS
1989 elements using qsort and comparison function CMPFN. F is the frame
1990 on which the fonts will be used. The global variable font_frame
1991 is temporarily set to F to make it available in CMPFN. */
1994 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
1996 struct font_name
*fonts
;
1998 int (*cmpfn
) P_ ((const void *, const void *));
2001 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2006 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2007 display in x_display_list. FONTS is a pointer to a vector of
2008 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2009 alternative patterns from Valternate_fontname_alist if no fonts are
2010 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2013 For all fonts found, set FONTS[i].name to the name of the font,
2014 allocated via xmalloc, and split font names into fields. Ignore
2015 fonts that we can't parse. Value is the number of fonts found.
2017 This is similar to x_list_fonts. The differences are:
2019 1. It avoids consing.
2020 2. It never calls XLoadQueryFont. */
2023 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2027 struct font_name
*fonts
;
2028 int nfonts
, try_alternatives_p
;
2029 int scalable_fonts_p
;
2031 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2035 /* Get the list of fonts matching PATTERN from the X server. */
2037 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2042 /* Make a copy of the font names we got from X, and
2043 split them into fields. */
2044 for (i
= j
= 0; i
< n
; ++i
)
2046 /* Make a copy of the font name. */
2047 fonts
[j
].name
= xstrdup (names
[i
]);
2049 /* Ignore fonts having a name that we can't parse. */
2050 if (!split_font_name (f
, fonts
+ j
, 1))
2051 xfree (fonts
[j
].name
);
2052 else if (font_scalable_p (fonts
+ j
))
2055 if (!scalable_fonts_p
2056 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2057 xfree (fonts
[j
].name
);
2060 #else /* !SCALABLE_FONTS */
2061 /* Always ignore scalable fonts. */
2062 xfree (fonts
[j
].name
);
2063 #endif /* !SCALABLE_FONTS */
2071 /* Free font names. */
2073 XFreeFontNames (names
);
2078 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2079 if (n
== 0 && try_alternatives_p
)
2081 Lisp_Object list
= Valternate_fontname_alist
;
2083 while (CONSP (list
))
2085 Lisp_Object entry
= XCAR (list
);
2087 && STRINGP (XCAR (entry
))
2088 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2095 Lisp_Object patterns
= XCAR (list
);
2098 while (CONSP (patterns
)
2099 /* If list is screwed up, give up. */
2100 && (name
= XCAR (patterns
),
2102 /* Ignore patterns equal to PATTERN because we tried that
2103 already with no success. */
2104 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2105 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2109 patterns
= XCDR (patterns
);
2117 /* Determine the first font matching PATTERN on frame F. Return in
2118 *FONT the matching font name, split into fields. Value is non-zero
2119 if a match was found. */
2122 first_font_matching (f
, pattern
, font
)
2125 struct font_name
*font
;
2128 struct font_name
*fonts
;
2130 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2131 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2135 bcopy (&fonts
[0], font
, sizeof *font
);
2137 fonts
[0].name
= NULL
;
2138 free_font_names (fonts
, nfonts
);
2145 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2146 using comparison function CMPFN. Value is the number of fonts
2147 found. If value is non-zero, *FONTS is set to a vector of
2148 font_name structures allocated from the heap containing matching
2149 fonts. Each element of *FONTS contains a name member that is also
2150 allocated from the heap. Font names in these structures are split
2151 into fields. Use free_font_names to free such an array. */
2154 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2157 int (*cmpfn
) P_ ((const void *, const void *));
2158 struct font_name
**fonts
;
2162 /* Get the list of fonts matching pattern. 100 should suffice. */
2163 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2164 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2165 nfonts
= XFASTINT (Vfont_list_limit
);
2167 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2169 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2171 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2174 /* Sort the resulting array and return it in *FONTS. If no
2175 fonts were found, make sure to set *FONTS to null. */
2177 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2188 /* Compare two font_name structures *A and *B. Value is analogous to
2189 strcmp. Sort order is given by the global variable
2190 font_sort_order. Font names are sorted so that, everything else
2191 being equal, fonts with a resolution closer to that of the frame on
2192 which they are used are listed first. The global variable
2193 font_frame is the frame on which we operate. */
2196 cmp_font_names (a
, b
)
2199 struct font_name
*x
= (struct font_name
*) a
;
2200 struct font_name
*y
= (struct font_name
*) b
;
2203 /* All strings have been converted to lower-case by split_font_name,
2204 so we can use strcmp here. */
2205 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2210 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2212 int j
= font_sort_order
[i
];
2213 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2218 /* Everything else being equal, we prefer fonts with an
2219 y-resolution closer to that of the frame. */
2220 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2221 int x_resy
= x
->numeric
[XLFD_RESY
];
2222 int y_resy
= y
->numeric
[XLFD_RESY
];
2223 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2231 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2232 is non-null list fonts matching that pattern. Otherwise, if
2233 REGISTRY_AND_ENCODING is non-null return only fonts with that
2234 registry and encoding, otherwise return fonts of any registry and
2235 encoding. Set *FONTS to a vector of font_name structures allocated
2236 from the heap containing the fonts found. Value is the number of
2240 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2244 char *registry_and_encoding
;
2245 struct font_name
**fonts
;
2247 if (pattern
== NULL
)
2252 if (registry_and_encoding
== NULL
)
2253 registry_and_encoding
= "*";
2255 pattern
= (char *) alloca (strlen (family
)
2256 + strlen (registry_and_encoding
)
2258 if (index (family
, '-'))
2259 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2261 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2264 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2268 /* Remove elements from LIST whose cars are `equal'. Called from
2269 x-font-list and x-font-family-list to remove duplicate font
2273 remove_duplicates (list
)
2276 Lisp_Object tail
= list
;
2278 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2280 Lisp_Object next
= XCDR (tail
);
2281 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2282 XCDR (tail
) = XCDR (next
);
2289 DEFUN ("x-font-list", Fxfont_list
, Sx_font_list
, 0, 2, 0,
2290 "Return a list of available fonts of family FAMILY on FRAME.\n\
2291 If FAMILY is omitted or nil, list all families.\n\
2292 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2294 If FRAME is omitted or nil, use the selected frame.\n\
2295 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2296 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2297 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2298 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2299 width, weight and slant of the font. These symbols are the same as for\n\
2300 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2301 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2302 giving the registry and encoding of the font.\n\
2303 The result list is sorted according to the current setting of\n\
2304 the face font sort order.")
2306 Lisp_Object family
, frame
;
2308 struct frame
*f
= check_x_frame (frame
);
2309 struct font_name
*fonts
;
2312 struct gcpro gcpro1
;
2313 char *family_pattern
;
2316 family_pattern
= "*";
2319 CHECK_STRING (family
, 1);
2320 family_pattern
= LSTRDUPA (family
);
2325 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2326 for (i
= nfonts
- 1; i
>= 0; --i
)
2328 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2331 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2333 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2334 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2335 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2336 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2337 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2338 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2339 tem
= build_font_name (fonts
+ i
);
2340 ASET (v
, 6, build_string (tem
));
2341 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2342 fonts
[i
].fields
[XLFD_ENCODING
]);
2343 ASET (v
, 7, build_string (tem
));
2346 result
= Fcons (v
, result
);
2351 remove_duplicates (result
);
2352 free_font_names (fonts
, nfonts
);
2358 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2360 "Return a list of available font families on FRAME.\n\
2361 If FRAME is omitted or nil, use the selected frame.\n\
2362 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2363 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2368 struct frame
*f
= check_x_frame (frame
);
2370 struct font_name
*fonts
;
2372 struct gcpro gcpro1
;
2373 int count
= specpdl_ptr
- specpdl
;
2376 /* Let's consider all fonts. Increase the limit for matching
2377 fonts until we have them all. */
2380 specbind (intern ("font-list-limit"), make_number (limit
));
2381 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2383 if (nfonts
== limit
)
2385 free_font_names (fonts
, nfonts
);
2394 for (i
= nfonts
- 1; i
>= 0; --i
)
2395 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2396 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2399 remove_duplicates (result
);
2400 free_font_names (fonts
, nfonts
);
2402 return unbind_to (count
, result
);
2406 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2407 "Return a list of the names of available fonts matching PATTERN.\n\
2408 If optional arguments FACE and FRAME are specified, return only fonts\n\
2409 the same size as FACE on FRAME.\n\
2410 PATTERN is a string, perhaps with wildcard characters;\n\
2411 the * character matches any substring, and\n\
2412 the ? character matches any single character.\n\
2413 PATTERN is case-insensitive.\n\
2414 FACE is a face name--a symbol.\n\
2416 The return value is a list of strings, suitable as arguments to\n\
2419 Fonts Emacs can't use may or may not be excluded\n\
2420 even if they match PATTERN and FACE.\n\
2421 The optional fourth argument MAXIMUM sets a limit on how many\n\
2422 fonts to match. The first MAXIMUM fonts are reported.\n\
2423 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2424 occupied by a character of a font. In that case, return only fonts\n\
2425 the WIDTH times as wide as FACE on FRAME.")
2426 (pattern
, face
, frame
, maximum
, width
)
2427 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2434 CHECK_STRING (pattern
, 0);
2440 CHECK_NATNUM (maximum
, 0);
2441 maxnames
= XINT (maximum
);
2445 CHECK_NUMBER (width
, 4);
2447 /* We can't simply call check_x_frame because this function may be
2448 called before any frame is created. */
2449 f
= frame_or_selected_frame (frame
, 2);
2452 /* Perhaps we have not yet created any frame. */
2457 /* Determine the width standard for comparison with the fonts we find. */
2463 /* This is of limited utility since it works with character
2464 widths. Keep it for compatibility. --gerd. */
2465 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2466 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2469 size
= face
->font
->max_bounds
.width
;
2471 size
= FRAME_FONT (f
)->max_bounds
.width
;
2474 size
*= XINT (width
);
2478 Lisp_Object args
[2];
2480 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2482 /* We don't have to check fontsets. */
2484 args
[1] = list_fontsets (f
, pattern
, size
);
2485 return Fnconc (2, args
);
2489 #endif /* HAVE_X_WINDOWS */
2493 /***********************************************************************
2495 ***********************************************************************/
2497 /* Access face attributes of face FACE, a Lisp vector. */
2499 #define LFACE_FAMILY(LFACE) \
2500 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2501 #define LFACE_HEIGHT(LFACE) \
2502 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2503 #define LFACE_WEIGHT(LFACE) \
2504 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2505 #define LFACE_SLANT(LFACE) \
2506 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2507 #define LFACE_UNDERLINE(LFACE) \
2508 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2509 #define LFACE_INVERSE(LFACE) \
2510 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2511 #define LFACE_FOREGROUND(LFACE) \
2512 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2513 #define LFACE_BACKGROUND(LFACE) \
2514 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2515 #define LFACE_STIPPLE(LFACE) \
2516 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2517 #define LFACE_SWIDTH(LFACE) \
2518 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2519 #define LFACE_OVERLINE(LFACE) \
2520 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2521 #define LFACE_STRIKE_THROUGH(LFACE) \
2522 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2523 #define LFACE_BOX(LFACE) \
2524 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2526 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2527 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2529 #define LFACEP(LFACE) \
2531 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2532 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2537 /* Check consistency of Lisp face attribute vector ATTRS. */
2540 check_lface_attrs (attrs
)
2543 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2544 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2545 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2546 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2547 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2548 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2549 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2550 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2551 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2552 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2553 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2554 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2555 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2556 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2557 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2558 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2559 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2560 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2561 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2562 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2563 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2564 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2565 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2566 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2567 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2568 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2569 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2570 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2571 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2572 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2573 #ifdef HAVE_WINDOW_SYSTEM
2574 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2575 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2576 || !NILP (Fpixmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2581 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2589 xassert (LFACEP (lface
));
2590 check_lface_attrs (XVECTOR (lface
)->contents
);
2594 #else /* GLYPH_DEBUG == 0 */
2596 #define check_lface_attrs(attrs) (void) 0
2597 #define check_lface(lface) (void) 0
2599 #endif /* GLYPH_DEBUG == 0 */
2602 /* Return the face definition of FACE_NAME on frame F. F null means
2603 return the global definition. FACE_NAME may be a string or a
2604 symbol (apparently Emacs 20.2 allows strings as face names in face
2605 text properties; ediff uses that). If SIGNAL_P is non-zero, signal
2606 an error if FACE_NAME is not a valid face name. If SIGNAL_P is
2607 zero, value is nil if FACE_NAME is not a valid face name. */
2609 static INLINE Lisp_Object
2610 lface_from_face_name (f
, face_name
, signal_p
)
2612 Lisp_Object face_name
;
2617 if (STRINGP (face_name
))
2618 face_name
= intern (XSTRING (face_name
)->data
);
2621 lface
= assq_no_quit (face_name
, f
->face_alist
);
2623 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2626 lface
= XCDR (lface
);
2628 signal_error ("Invalid face", face_name
);
2630 check_lface (lface
);
2635 /* Get face attributes of face FACE_NAME from frame-local faces on
2636 frame F. Store the resulting attributes in ATTRS which must point
2637 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2638 is non-zero, signal an error if FACE_NAME does not name a face.
2639 Otherwise, value is zero if FACE_NAME is not a face. */
2642 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2644 Lisp_Object face_name
;
2651 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2654 bcopy (XVECTOR (lface
)->contents
, attrs
,
2655 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2665 /* Non-zero if all attributes in face attribute vector ATTRS are
2666 specified, i.e. are non-nil. */
2669 lface_fully_specified_p (attrs
)
2674 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2675 if (UNSPECIFIEDP (attrs
[i
]))
2678 return i
== LFACE_VECTOR_SIZE
;
2682 #ifdef HAVE_X_WINDOWS
2684 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2685 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2686 LFACE. Ignore fields of FONT_NAME containing wildcards. Value is
2687 zero if not successful because FONT_NAME was not in a valid format.
2688 A valid format is one that is suitable for split_font_name, see the
2692 set_lface_from_font_name (f
, lface
, font_name
, force_p
)
2698 struct font_name font
;
2701 int free_font_name_p
= 0;
2703 /* If FONT_NAME contains wildcards, use the first matching font. */
2704 if (index (font_name
, '*') || index (font_name
, '?'))
2706 if (!first_font_matching (f
, font_name
, &font
))
2708 free_font_name_p
= 1;
2712 font
.name
= STRDUPA (font_name
);
2713 if (!split_font_name (f
, &font
, 1))
2715 /* The font name may be something like `6x13'. Make
2716 sure we use the full name. */
2717 struct font_info
*font_info
;
2720 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2721 CHARSET_ASCII
, font_name
, -1);
2727 font
.name
= STRDUPA (font_info
->full_name
);
2728 split_font_name (f
, &font
, 1);
2731 /* FONT_NAME should not be a fontset name, here. */
2732 xassert (xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0);
2735 /* Set attributes only if unspecified, otherwise face defaults for
2736 new frames would never take effect. */
2738 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2740 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2741 + strlen (font
.fields
[XLFD_FOUNDRY
])
2743 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2744 font
.fields
[XLFD_FAMILY
]);
2745 LFACE_FAMILY (lface
) = build_string (buffer
);
2748 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2750 pt
= xlfd_point_size (f
, &font
);
2752 LFACE_HEIGHT (lface
) = make_number (pt
);
2755 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2756 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2758 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2759 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2761 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2762 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2764 if (free_font_name_p
)
2770 #endif /* HAVE_X_WINDOWS */
2773 /* Merge two Lisp face attribute vectors FROM and TO and store the
2774 resulting attributes in TO. Every non-nil attribute of FROM
2775 overrides the corresponding attribute of TO. */
2778 merge_face_vectors (from
, to
)
2779 Lisp_Object
*from
, *to
;
2782 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2783 if (!UNSPECIFIEDP (from
[i
]))
2788 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2789 is a face property, determine the resulting face attributes on
2790 frame F, and store them in TO. PROP may be a single face
2791 specification or a list of such specifications. Each face
2792 specification can be
2794 1. A symbol or string naming a Lisp face.
2796 2. A property list of the form (KEYWORD VALUE ...) where each
2797 KEYWORD is a face attribute name, and value is an appropriate value
2800 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2801 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2802 for compatibility with 20.2.
2804 Face specifications earlier in lists take precedence over later
2808 merge_face_vector_with_property (f
, to
, prop
)
2815 Lisp_Object first
= XCAR (prop
);
2817 if (EQ (first
, Qforeground_color
)
2818 || EQ (first
, Qbackground_color
))
2820 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2821 . COLOR). COLOR must be a string. */
2822 Lisp_Object color_name
= XCDR (prop
);
2823 Lisp_Object color
= first
;
2825 if (STRINGP (color_name
))
2827 if (EQ (color
, Qforeground_color
))
2828 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2830 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2833 add_to_log (f
, "Invalid face color", color_name
, Qnil
);
2835 else if (SYMBOLP (first
)
2836 && *XSYMBOL (first
)->name
->data
== ':')
2838 /* Assume this is the property list form. */
2839 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2841 Lisp_Object keyword
= XCAR (prop
);
2842 Lisp_Object value
= XCAR (XCDR (prop
));
2844 if (EQ (keyword
, QCfamily
))
2846 if (STRINGP (value
))
2847 to
[LFACE_FAMILY_INDEX
] = value
;
2849 add_to_log (f
, "Illegal face font family", value
, Qnil
);
2851 else if (EQ (keyword
, QCheight
))
2853 if (INTEGERP (value
))
2854 to
[LFACE_HEIGHT_INDEX
] = value
;
2856 add_to_log (f
, "Illegal face font height", value
, Qnil
);
2858 else if (EQ (keyword
, QCweight
))
2861 && face_numeric_weight (value
) >= 0)
2862 to
[LFACE_WEIGHT_INDEX
] = value
;
2864 add_to_log (f
, "Illegal face weight", value
, Qnil
);
2866 else if (EQ (keyword
, QCslant
))
2869 && face_numeric_slant (value
) >= 0)
2870 to
[LFACE_SLANT_INDEX
] = value
;
2872 add_to_log (f
, "Illegal face slant", value
, Qnil
);
2874 else if (EQ (keyword
, QCunderline
))
2879 to
[LFACE_UNDERLINE_INDEX
] = value
;
2881 add_to_log (f
, "Illegal face underline", value
, Qnil
);
2883 else if (EQ (keyword
, QCoverline
))
2888 to
[LFACE_OVERLINE_INDEX
] = value
;
2890 add_to_log (f
, "Illegal face overline", value
, Qnil
);
2892 else if (EQ (keyword
, QCstrike_through
))
2897 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2899 add_to_log (f
, "Illegal face strike-through", value
, Qnil
);
2901 else if (EQ (keyword
, QCbox
))
2904 value
= make_number (1);
2905 if (INTEGERP (value
)
2909 to
[LFACE_BOX_INDEX
] = value
;
2911 add_to_log (f
, "Illegal face box", value
, Qnil
);
2913 else if (EQ (keyword
, QCinverse_video
)
2914 || EQ (keyword
, QCreverse_video
))
2916 if (EQ (value
, Qt
) || NILP (value
))
2917 to
[LFACE_INVERSE_INDEX
] = value
;
2919 add_to_log (f
, "Illegal face inverse-video", value
, Qnil
);
2921 else if (EQ (keyword
, QCforeground
))
2923 if (STRINGP (value
))
2924 to
[LFACE_FOREGROUND_INDEX
] = value
;
2926 add_to_log (f
, "Illegal face foreground", value
, Qnil
);
2928 else if (EQ (keyword
, QCbackground
))
2930 if (STRINGP (value
))
2931 to
[LFACE_BACKGROUND_INDEX
] = value
;
2933 add_to_log (f
, "Illegal face background", value
, Qnil
);
2935 else if (EQ (keyword
, QCstipple
))
2937 #ifdef HAVE_X_WINDOWS
2938 Lisp_Object pixmap_p
= Fpixmap_spec_p (value
);
2939 if (!NILP (pixmap_p
))
2940 to
[LFACE_STIPPLE_INDEX
] = value
;
2942 add_to_log (f
, "Illegal face stipple", value
, Qnil
);
2945 else if (EQ (keyword
, QCwidth
))
2948 && face_numeric_swidth (value
) >= 0)
2949 to
[LFACE_SWIDTH_INDEX
] = value
;
2951 add_to_log (f
, "Illegal face width", value
, Qnil
);
2954 add_to_log (f
, "Invalid attribute %s in face property",
2957 prop
= XCDR (XCDR (prop
));
2962 /* This is a list of face specs. Specifications at the
2963 beginning of the list take precedence over later
2964 specifications, so we have to merge starting with the
2965 last specification. */
2966 Lisp_Object next
= XCDR (prop
);
2968 merge_face_vector_with_property (f
, to
, next
);
2969 merge_face_vector_with_property (f
, to
, first
);
2974 /* PROP ought to be a face name. */
2975 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
2977 add_to_log (f
, "Invalid face text property value: %s", prop
, Qnil
);
2979 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
2984 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2985 Sinternal_make_lisp_face
, 1, 2, 0,
2986 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
2987 If FACE was not known as a face before, create a new one.\n\
2988 If optional argument FRAME is specified, make a frame-local face\n\
2989 for that frame. Otherwise operate on the global face definition.\n\
2990 Value is a vector of face attributes.")
2992 Lisp_Object face
, frame
;
2994 Lisp_Object global_lface
, lface
;
2998 CHECK_SYMBOL (face
, 0);
2999 global_lface
= lface_from_face_name (NULL
, face
, 0);
3003 CHECK_LIVE_FRAME (frame
, 1);
3005 lface
= lface_from_face_name (f
, face
, 0);
3008 f
= NULL
, lface
= Qnil
;
3010 /* Add a global definition if there is none. */
3011 if (NILP (global_lface
))
3013 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3015 XVECTOR (global_lface
)->contents
[0] = Qface
;
3016 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3017 Vface_new_frame_defaults
);
3019 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3020 face id to Lisp face is given by the vector lface_id_to_name.
3021 The mapping from Lisp face to Lisp face id is given by the
3022 property `face' of the Lisp face name. */
3023 if (next_lface_id
== lface_id_to_name_size
)
3025 int new_size
= max (50, 2 * lface_id_to_name_size
);
3026 int sz
= new_size
* sizeof *lface_id_to_name
;
3027 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3028 lface_id_to_name_size
= new_size
;
3031 lface_id_to_name
[next_lface_id
] = face
;
3032 Fput (face
, Qface
, make_number (next_lface_id
));
3036 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3037 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3039 /* Add a frame-local definition. */
3044 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3046 XVECTOR (lface
)->contents
[0] = Qface
;
3047 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3050 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3051 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3054 lface
= global_lface
;
3056 xassert (LFACEP (lface
));
3057 check_lface (lface
);
3062 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3063 Sinternal_lisp_face_p
, 1, 2, 0,
3064 "Return non-nil if FACE names a face.\n\
3065 If optional second parameter FRAME is non-nil, check for the\n\
3066 existence of a frame-local face with name FACE on that frame.\n\
3067 Otherwise check for the existence of a global face.")
3069 Lisp_Object face
, frame
;
3075 CHECK_LIVE_FRAME (frame
, 1);
3076 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3079 lface
= lface_from_face_name (NULL
, face
, 0);
3085 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3086 Sinternal_copy_lisp_face
, 4, 4, 0,
3087 "Copy face FROM to TO.\n\
3088 If FRAME it t, copy the global face definition of FROM to the\n\
3089 global face definition of TO. Otherwise, copy the frame-local\n\
3090 definition of FROM on FRAME to the frame-local definition of TO\n\
3091 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3094 (from
, to
, frame
, new_frame
)
3095 Lisp_Object from
, to
, frame
, new_frame
;
3097 Lisp_Object lface
, copy
;
3099 CHECK_SYMBOL (from
, 0);
3100 CHECK_SYMBOL (to
, 1);
3101 if (NILP (new_frame
))
3106 /* Copy global definition of FROM. We don't make copies of
3107 strings etc. because 20.2 didn't do it either. */
3108 lface
= lface_from_face_name (NULL
, from
, 1);
3109 copy
= Finternal_make_lisp_face (to
, Qnil
);
3113 /* Copy frame-local definition of FROM. */
3114 CHECK_LIVE_FRAME (frame
, 2);
3115 CHECK_LIVE_FRAME (new_frame
, 3);
3116 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3117 copy
= Finternal_make_lisp_face (to
, new_frame
);
3120 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3121 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3127 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3128 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3129 "Set attribute ATTR of FACE to VALUE.\n\
3130 If optional argument FRAME is given, set the face attribute of face FACE\n\
3131 on that frame. If FRAME is t, set the attribute of the default for face\n\
3132 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3134 (face
, attr
, value
, frame
)
3135 Lisp_Object face
, attr
, value
, frame
;
3138 Lisp_Object old_value
= Qnil
;
3139 int font_related_attr_p
= 0;
3141 CHECK_SYMBOL (face
, 0);
3142 CHECK_SYMBOL (attr
, 1);
3144 /* Set lface to the Lisp attribute vector of FACE. */
3146 lface
= lface_from_face_name (NULL
, face
, 1);
3150 XSETFRAME (frame
, selected_frame
);
3152 CHECK_LIVE_FRAME (frame
, 3);
3153 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3155 /* If a frame-local face doesn't exist yet, create one. */
3157 lface
= Finternal_make_lisp_face (face
, frame
);
3160 if (EQ (attr
, QCfamily
))
3162 if (!UNSPECIFIEDP (value
))
3164 CHECK_STRING (value
, 3);
3165 if (XSTRING (value
)->size
== 0)
3166 signal_error ("Invalid face family", value
);
3168 old_value
= LFACE_FAMILY (lface
);
3169 LFACE_FAMILY (lface
) = value
;
3170 font_related_attr_p
= 1;
3172 else if (EQ (attr
, QCheight
))
3174 if (!UNSPECIFIEDP (value
))
3176 CHECK_NUMBER (value
, 3);
3177 if (XINT (value
) <= 0)
3178 signal_error ("Invalid face height", value
);
3180 old_value
= LFACE_HEIGHT (lface
);
3181 LFACE_HEIGHT (lface
) = value
;
3182 font_related_attr_p
= 1;
3184 else if (EQ (attr
, QCweight
))
3186 if (!UNSPECIFIEDP (value
))
3188 CHECK_SYMBOL (value
, 3);
3189 if (face_numeric_weight (value
) < 0)
3190 signal_error ("Invalid face weight", value
);
3192 old_value
= LFACE_WEIGHT (lface
);
3193 LFACE_WEIGHT (lface
) = value
;
3194 font_related_attr_p
= 1;
3196 else if (EQ (attr
, QCslant
))
3198 if (!UNSPECIFIEDP (value
))
3200 CHECK_SYMBOL (value
, 3);
3201 if (face_numeric_slant (value
) < 0)
3202 signal_error ("Invalid face slant", value
);
3204 old_value
= LFACE_SLANT (lface
);
3205 LFACE_SLANT (lface
) = value
;
3206 font_related_attr_p
= 1;
3208 else if (EQ (attr
, QCunderline
))
3210 if (!UNSPECIFIEDP (value
))
3211 if ((SYMBOLP (value
)
3213 && !EQ (value
, Qnil
))
3214 /* Underline color. */
3216 && XSTRING (value
)->size
== 0))
3217 signal_error ("Invalid face underline", value
);
3219 old_value
= LFACE_UNDERLINE (lface
);
3220 LFACE_UNDERLINE (lface
) = value
;
3222 else if (EQ (attr
, QCoverline
))
3224 if (!UNSPECIFIEDP (value
))
3225 if ((SYMBOLP (value
)
3227 && !EQ (value
, Qnil
))
3228 /* Overline color. */
3230 && XSTRING (value
)->size
== 0))
3231 signal_error ("Invalid face overline", value
);
3233 old_value
= LFACE_OVERLINE (lface
);
3234 LFACE_OVERLINE (lface
) = value
;
3236 else if (EQ (attr
, QCstrike_through
))
3238 if (!UNSPECIFIEDP (value
))
3239 if ((SYMBOLP (value
)
3241 && !EQ (value
, Qnil
))
3242 /* Strike-through color. */
3244 && XSTRING (value
)->size
== 0))
3245 signal_error ("Invalid face strike-through", value
);
3247 old_value
= LFACE_STRIKE_THROUGH (lface
);
3248 LFACE_STRIKE_THROUGH (lface
) = value
;
3250 else if (EQ (attr
, QCbox
))
3254 /* Allow t meaning a simple box of width 1 in foreground color
3257 value
= make_number (1);
3259 if (UNSPECIFIEDP (value
))
3261 else if (NILP (value
))
3263 else if (INTEGERP (value
))
3264 valid_p
= XINT (value
) > 0;
3265 else if (STRINGP (value
))
3266 valid_p
= XSTRING (value
)->size
> 0;
3267 else if (CONSP (value
))
3283 if (EQ (k
, QCline_width
))
3285 if (!INTEGERP (v
) || XINT (v
) <= 0)
3288 else if (EQ (k
, QCcolor
))
3290 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3293 else if (EQ (k
, QCstyle
))
3295 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3302 valid_p
= NILP (tem
);
3308 signal_error ("Invalid face box", value
);
3310 old_value
= LFACE_BOX (lface
);
3311 LFACE_BOX (lface
) = value
;
3313 else if (EQ (attr
, QCinverse_video
)
3314 || EQ (attr
, QCreverse_video
))
3316 if (!UNSPECIFIEDP (value
))
3318 CHECK_SYMBOL (value
, 3);
3319 if (!EQ (value
, Qt
) && !NILP (value
))
3320 signal_error ("Invalid inverse-video face attribute value", value
);
3322 old_value
= LFACE_INVERSE (lface
);
3323 LFACE_INVERSE (lface
) = value
;
3325 else if (EQ (attr
, QCforeground
))
3327 if (!UNSPECIFIEDP (value
))
3329 /* Don't check for valid color names here because it depends
3330 on the frame (display) whether the color will be valid
3331 when the face is realized. */
3332 CHECK_STRING (value
, 3);
3333 if (XSTRING (value
)->size
== 0)
3334 signal_error ("Empty foreground color value", value
);
3336 old_value
= LFACE_FOREGROUND (lface
);
3337 LFACE_FOREGROUND (lface
) = value
;
3339 else if (EQ (attr
, QCbackground
))
3341 if (!UNSPECIFIEDP (value
))
3343 /* Don't check for valid color names here because it depends
3344 on the frame (display) whether the color will be valid
3345 when the face is realized. */
3346 CHECK_STRING (value
, 3);
3347 if (XSTRING (value
)->size
== 0)
3348 signal_error ("Empty background color value", value
);
3350 old_value
= LFACE_BACKGROUND (lface
);
3351 LFACE_BACKGROUND (lface
) = value
;
3353 else if (EQ (attr
, QCstipple
))
3355 #ifdef HAVE_X_WINDOWS
3356 if (!UNSPECIFIEDP (value
)
3358 && NILP (Fpixmap_spec_p (value
)))
3359 signal_error ("Invalid stipple attribute", value
);
3360 old_value
= LFACE_STIPPLE (lface
);
3361 LFACE_STIPPLE (lface
) = value
;
3362 #endif /* HAVE_X_WINDOWS */
3364 else if (EQ (attr
, QCwidth
))
3366 if (!UNSPECIFIEDP (value
))
3368 CHECK_SYMBOL (value
, 3);
3369 if (face_numeric_swidth (value
) < 0)
3370 signal_error ("Invalid face width", value
);
3372 old_value
= LFACE_SWIDTH (lface
);
3373 LFACE_SWIDTH (lface
) = value
;
3374 font_related_attr_p
= 1;
3376 else if (EQ (attr
, QCfont
))
3378 #ifdef HAVE_X_WINDOWS
3379 /* Set font-related attributes of the Lisp face from an
3383 CHECK_STRING (value
, 3);
3387 f
= check_x_frame (frame
);
3389 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1))
3390 signal_error ("Invalid font name", value
);
3392 font_related_attr_p
= 1;
3393 #endif /* HAVE_X_WINDOWS */
3395 else if (EQ (attr
, QCbold
))
3397 old_value
= LFACE_WEIGHT (lface
);
3398 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3399 font_related_attr_p
= 1;
3401 else if (EQ (attr
, QCitalic
))
3403 old_value
= LFACE_SLANT (lface
);
3404 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3405 font_related_attr_p
= 1;
3408 signal_error ("Invalid face attribute name", attr
);
3410 /* Changing a named face means that all realized faces depending on
3411 that face are invalid. Since we cannot tell which realized faces
3412 depend on the face, make sure they are all removed. This is done
3413 by incrementing face_change_count. The next call to
3414 init_iterator will then free realized faces. */
3416 && (EQ (attr
, QCfont
)
3417 || NILP (Fequal (old_value
, value
))))
3419 ++face_change_count
;
3420 ++windows_or_buffers_changed
;
3423 #ifdef HAVE_X_WINDOWS
3424 /* Changed font-related attributes of the `default' face are
3425 reflected in changed `font' frame parameters. */
3426 if (EQ (face
, Qdefault
)
3428 && font_related_attr_p
3429 && lface_fully_specified_p (XVECTOR (lface
)->contents
)
3430 && NILP (Fequal (old_value
, value
)))
3431 set_font_frame_param (frame
, lface
);
3433 #endif /* HAVE_X_WINDOWS */
3439 #ifdef HAVE_X_WINDOWS
3441 /* Set the `font' frame parameter of FRAME according to `default' face
3442 attributes LFACE. */
3445 set_font_frame_param (frame
, lface
)
3446 Lisp_Object frame
, lface
;
3448 struct frame
*f
= XFRAME (frame
);
3449 Lisp_Object frame_font
;
3453 /* Get FRAME's font parameter. */
3454 frame_font
= Fassq (Qfont
, f
->param_alist
);
3455 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3456 frame_font
= XCDR (frame_font
);
3458 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3461 /* Frame parameter is a fontset name. Modify the fontset so
3462 that all its fonts reflect face attributes LFACE. */
3464 struct fontset_info
*fontset_info
;
3466 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3468 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3469 if (fontset_info
->fontname
[charset
])
3471 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3473 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3474 build_string (font
), frame
);
3480 /* Frame parameter is an X font name. I believe this can
3481 only happen in unibyte mode. */
3482 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3483 -1, Vface_default_registry
);
3486 store_frame_param (f
, Qfont
, build_string (font
));
3493 /* Get the value of X resource RESOURCE, class CLASS for the display
3494 of frame FRAME. This is here because ordinary `x-get-resource'
3495 doesn't take a frame argument. */
3497 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3498 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3499 (resource
, class, frame
)
3500 Lisp_Object resource
, class, frame
;
3503 CHECK_STRING (resource
, 0);
3504 CHECK_STRING (class, 1);
3505 CHECK_LIVE_FRAME (frame
, 2);
3507 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3508 resource
, class, Qnil
, Qnil
);
3514 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3515 If VALUE is "on" or "true", return t. If VALUE is "off" or
3516 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3517 error; if SIGNAL_P is zero, return 0. */
3520 face_boolean_x_resource_value (value
, signal_p
)
3524 Lisp_Object result
= make_number (0);
3526 xassert (STRINGP (value
));
3528 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3529 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3531 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3532 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3534 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3535 result
= Qunspecified
;
3537 signal_error ("Invalid face attribute value from X resource", value
);
3543 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3544 Finternal_set_lisp_face_attribute_from_resource
,
3545 Sinternal_set_lisp_face_attribute_from_resource
,
3547 (face
, attr
, value
, frame
)
3548 Lisp_Object face
, attr
, value
, frame
;
3550 CHECK_SYMBOL (face
, 0);
3551 CHECK_SYMBOL (attr
, 1);
3552 CHECK_STRING (value
, 2);
3554 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3555 value
= Qunspecified
;
3556 else if (EQ (attr
, QCheight
))
3558 value
= Fstring_to_number (value
, make_number (10));
3559 if (XINT (value
) <= 0)
3560 signal_error ("Invalid face height from X resource", value
);
3562 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3563 value
= face_boolean_x_resource_value (value
, 1);
3564 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3565 value
= intern (XSTRING (value
)->data
);
3566 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3567 value
= face_boolean_x_resource_value (value
, 1);
3568 else if (EQ (attr
, QCunderline
)
3569 || EQ (attr
, QCoverline
)
3570 || EQ (attr
, QCstrike_through
)
3571 || EQ (attr
, QCbox
))
3573 Lisp_Object boolean_value
;
3575 /* If the result of face_boolean_x_resource_value is t or nil,
3576 VALUE does NOT specify a color. */
3577 boolean_value
= face_boolean_x_resource_value (value
, 0);
3578 if (SYMBOLP (boolean_value
))
3579 value
= boolean_value
;
3582 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3586 #endif /* HAVE_X_WINDOWS */
3590 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3591 Sinternal_get_lisp_face_attribute
,
3593 "Return face attribute KEYWORD of face SYMBOL.\n\
3594 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
3595 face attribute name, signal an error.\n\
3596 If the optional argument FRAME is given, report on face FACE in that\n\
3597 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
3598 frames). If FRAME is omitted or nil, use the selected frame.")
3599 (symbol
, keyword
, frame
)
3600 Lisp_Object symbol
, keyword
, frame
;
3602 Lisp_Object lface
, value
= Qnil
;
3604 CHECK_SYMBOL (symbol
, 0);
3605 CHECK_SYMBOL (keyword
, 1);
3608 lface
= lface_from_face_name (NULL
, symbol
, 1);
3612 XSETFRAME (frame
, selected_frame
);
3613 CHECK_LIVE_FRAME (frame
, 2);
3614 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3617 if (EQ (keyword
, QCfamily
))
3618 value
= LFACE_FAMILY (lface
);
3619 else if (EQ (keyword
, QCheight
))
3620 value
= LFACE_HEIGHT (lface
);
3621 else if (EQ (keyword
, QCweight
))
3622 value
= LFACE_WEIGHT (lface
);
3623 else if (EQ (keyword
, QCslant
))
3624 value
= LFACE_SLANT (lface
);
3625 else if (EQ (keyword
, QCunderline
))
3626 value
= LFACE_UNDERLINE (lface
);
3627 else if (EQ (keyword
, QCoverline
))
3628 value
= LFACE_OVERLINE (lface
);
3629 else if (EQ (keyword
, QCstrike_through
))
3630 value
= LFACE_STRIKE_THROUGH (lface
);
3631 else if (EQ (keyword
, QCbox
))
3632 value
= LFACE_BOX (lface
);
3633 else if (EQ (keyword
, QCinverse_video
)
3634 || EQ (keyword
, QCreverse_video
))
3635 value
= LFACE_INVERSE (lface
);
3636 else if (EQ (keyword
, QCforeground
))
3637 value
= LFACE_FOREGROUND (lface
);
3638 else if (EQ (keyword
, QCbackground
))
3639 value
= LFACE_BACKGROUND (lface
);
3640 else if (EQ (keyword
, QCstipple
))
3641 value
= LFACE_STIPPLE (lface
);
3642 else if (EQ (keyword
, QCwidth
))
3643 value
= LFACE_SWIDTH (lface
);
3645 signal_error ("Invalid face attribute name", keyword
);
3651 DEFUN ("internal-lisp-face-attribute-values",
3652 Finternal_lisp_face_attribute_values
,
3653 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3654 "Return a list of valid discrete values for face attribute ATTR.\n\
3655 Value is nil if ATTR doesn't have a discrete set of valid values.")
3659 Lisp_Object result
= Qnil
;
3661 CHECK_SYMBOL (attr
, 0);
3663 if (EQ (attr
, QCweight
)
3664 || EQ (attr
, QCslant
)
3665 || EQ (attr
, QCwidth
))
3667 /* Extract permissible symbols from tables. */
3668 struct table_entry
*table
;
3671 if (EQ (attr
, QCweight
))
3672 table
= weight_table
, dim
= DIM (weight_table
);
3673 else if (EQ (attr
, QCslant
))
3674 table
= slant_table
, dim
= DIM (slant_table
);
3676 table
= swidth_table
, dim
= DIM (swidth_table
);
3678 for (i
= 0; i
< dim
; ++i
)
3680 Lisp_Object symbol
= *table
[i
].symbol
;
3681 Lisp_Object tail
= result
;
3684 && !EQ (XCAR (tail
), symbol
))
3688 result
= Fcons (symbol
, result
);
3691 else if (EQ (attr
, QCunderline
))
3692 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3693 else if (EQ (attr
, QCoverline
))
3694 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3695 else if (EQ (attr
, QCstrike_through
))
3696 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3697 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3698 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3704 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3705 Sinternal_merge_in_global_face
, 2, 2, 0,
3706 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
3708 Lisp_Object face
, frame
;
3710 Lisp_Object global_lface
, local_lface
;
3711 CHECK_LIVE_FRAME (frame
, 1);
3712 global_lface
= lface_from_face_name (NULL
, face
, 1);
3713 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3714 if (NILP (local_lface
))
3715 local_lface
= Finternal_make_lisp_face (face
, frame
);
3716 merge_face_vectors (XVECTOR (global_lface
)->contents
,
3717 XVECTOR (local_lface
)->contents
);
3722 /* The following function is implemented for compatibility with 20.2.
3723 The function is used in x-resolve-fonts when it is asked to
3724 return fonts with the same size as the font of a face. This is
3725 done in fontset.el. */
3727 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
3728 "Return the font name of face FACE, or nil if it is unspecified.\n\
3729 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3730 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3731 The font default for a face is either nil, or a list\n\
3732 of the form (bold), (italic) or (bold italic).\n\
3733 If FRAME is omitted or nil, use the selected frame.")
3735 Lisp_Object face
, frame
;
3739 Lisp_Object result
= Qnil
;
3740 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3742 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3743 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3744 result
= Fcons (Qbold
, result
);
3746 if (!NILP (LFACE_SLANT (lface
))
3747 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3748 result
= Fcons (Qitalic
, result
);
3754 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3755 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
3756 struct face
*face
= FACE_FROM_ID (f
, face_id
);
3757 return build_string (face
->font_name
);
3762 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3763 all attributes are `equal'. Tries to be fast because this function
3764 is called quite often. */
3767 lface_equal_p (v1
, v2
)
3768 Lisp_Object
*v1
, *v2
;
3772 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3774 Lisp_Object a
= v1
[i
];
3775 Lisp_Object b
= v2
[i
];
3777 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3778 and the other is specified. */
3779 equal_p
= XTYPE (a
) == XTYPE (b
);
3788 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
3789 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
3790 XSTRING (a
)->size
) == 0);
3799 equal_p
= !NILP (Fequal (a
, b
));
3809 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3810 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3811 "True if FACE1 and FACE2 are equal.\n\
3812 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3813 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3814 If FRAME is omitted or nil, use the selected frame.")
3815 (face1
, face2
, frame
)
3816 Lisp_Object face1
, face2
, frame
;
3820 Lisp_Object lface1
, lface2
;
3825 /* Don't use check_x_frame here because this function is called
3826 before X frames exist. At that time, if FRAME is nil,
3827 selected_frame will be used which is the frame dumped with
3828 Emacs. That frame is not an X frame. */
3829 f
= frame_or_selected_frame (frame
, 2);
3831 lface1
= lface_from_face_name (NULL
, face1
, 1);
3832 lface2
= lface_from_face_name (NULL
, face2
, 1);
3833 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
3834 XVECTOR (lface2
)->contents
);
3835 return equal_p
? Qt
: Qnil
;
3839 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3840 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3841 "True if FACE has no attribute specified.\n\
3842 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3843 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3844 If FRAME is omitted or nil, use the selected frame.")
3846 Lisp_Object face
, frame
;
3856 CHECK_LIVE_FRAME (frame
, 0);
3861 lface
= lface_from_face_name (NULL
, face
, 1);
3863 lface
= lface_from_face_name (f
, face
, 1);
3865 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3866 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
3869 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
3873 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
3875 "Return an alist of frame-local faces defined on FRAME.\n\
3876 For internal use only.")
3880 struct frame
*f
= frame_or_selected_frame (frame
, 0);
3881 return f
->face_alist
;
3885 /* Return a hash code for Lisp string STRING with case ignored. Used
3886 below in computing a hash value for a Lisp face. */
3888 static INLINE
unsigned
3889 hash_string_case_insensitive (string
)
3894 xassert (STRINGP (string
));
3895 for (s
= XSTRING (string
)->data
; *s
; ++s
)
3896 hash
= (hash
<< 1) ^ tolower (*s
);
3901 /* Return a hash code for face attribute vector V. */
3903 static INLINE
unsigned
3907 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
3908 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
3909 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
3910 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
3911 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
3912 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
3913 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
3917 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
3918 considering charsets/registries). They do if they specify the same
3919 family, point size, weight, width and slant. Both LFACE1 and
3920 LFACE2 must be fully-specified. */
3923 lface_same_font_attributes_p (lface1
, lface2
)
3924 Lisp_Object
*lface1
, *lface2
;
3926 xassert (lface_fully_specified_p (lface1
)
3927 && lface_fully_specified_p (lface2
));
3928 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
3929 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
3930 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
3931 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
3932 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
3933 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
3934 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
3939 /***********************************************************************
3941 ***********************************************************************/
3943 /* Allocate and return a new realized face for Lisp face attribute
3944 vector ATTR, charset CHARSET, and registry REGISTRY. */
3946 static struct face
*
3947 make_realized_face (attr
, charset
, registry
)
3950 Lisp_Object registry
;
3952 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
3953 bzero (face
, sizeof *face
);
3954 face
->charset
= charset
;
3955 face
->registry
= registry
;
3956 bcopy (attr
, face
->lface
, sizeof face
->lface
);
3961 /* Free realized face FACE, including its X resources. FACE may
3965 free_realized_face (f
, face
)
3971 #ifdef HAVE_X_WINDOWS
3976 x_free_gc (f
, face
->gc
);
3980 free_face_colors (f
, face
);
3981 x_destroy_bitmap (f
, face
->stipple
);
3983 #endif /* HAVE_X_WINDOWS */
3990 /* Prepare face FACE for subsequent display on frame F. This
3991 allocated GCs if they haven't been allocated yet or have been freed
3992 by clearing the face cache. */
3995 prepare_face_for_display (f
, face
)
3999 #ifdef HAVE_X_WINDOWS
4000 xassert (FRAME_X_P (f
));
4005 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4007 xgcv
.foreground
= face
->foreground
;
4008 xgcv
.background
= face
->background
;
4009 xgcv
.graphics_exposures
= False
;
4011 /* The font of FACE may be null if we couldn't load it. */
4014 xgcv
.font
= face
->font
->fid
;
4021 xgcv
.fill_style
= FillOpaqueStippled
;
4022 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4023 mask
|= GCFillStyle
| GCStipple
;
4026 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4033 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4034 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4035 ISO8859-1 if the ASCII face suffices. */
4038 face_suitable_for_iso8859_1_p (face
)
4041 int len
= strlen (face
->font_name
);
4042 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4046 /* Value is non-zero if FACE is suitable for displaying characters
4047 of CHARSET. CHARSET < 0 means unibyte text. */
4050 face_suitable_for_charset_p (face
, charset
)
4058 if (EQ (face
->registry
, Vface_default_registry
)
4059 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4062 else if (face
->charset
== charset
)
4064 else if (face
->charset
== CHARSET_ASCII
4065 && charset
== charset_latin_iso8859_1
)
4066 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4067 else if (face
->charset
== charset_latin_iso8859_1
4068 && charset
== CHARSET_ASCII
)
4076 /***********************************************************************
4078 ***********************************************************************/
4080 /* Return a new face cache for frame F. */
4082 static struct face_cache
*
4086 struct face_cache
*c
;
4089 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4090 bzero (c
, sizeof *c
);
4091 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4092 c
->buckets
= (struct face
**) xmalloc (size
);
4093 bzero (c
->buckets
, size
);
4095 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4101 /* Clear out all graphics contexts for all realized faces, except for
4102 the basic faces. This should be done from time to time just to avoid
4103 keeping too many graphics contexts that are no longer needed. */
4107 struct face_cache
*c
;
4109 if (c
&& FRAME_X_P (c
->f
))
4111 #ifdef HAVE_X_WINDOWS
4113 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4115 struct face
*face
= c
->faces_by_id
[i
];
4116 if (face
&& face
->gc
)
4118 x_free_gc (c
->f
, face
->gc
);
4122 #endif /* HAVE_X_WINDOWS */
4127 /* Free all realized faces in face cache C, including basic faces. C
4128 may be null. If faces are freed, make sure the frame's current
4129 matrix is marked invalid, so that a display caused by an expose
4130 event doesn't try to use faces we destroyed. */
4133 free_realized_faces (c
)
4134 struct face_cache
*c
;
4139 struct frame
*f
= c
->f
;
4141 for (i
= 0; i
< c
->used
; ++i
)
4143 free_realized_face (f
, c
->faces_by_id
[i
]);
4144 c
->faces_by_id
[i
] = NULL
;
4148 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4149 bzero (c
->buckets
, size
);
4151 /* Must do a thorough redisplay the next time. Mark current
4152 matrices as invalid because they will reference faces freed
4153 above. This function is also called when a frame is
4154 destroyed. In this case, the root window of F is nil. */
4155 if (WINDOWP (f
->root_window
))
4157 clear_current_matrices (f
);
4158 ++windows_or_buffers_changed
;
4164 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4165 This is done after attributes of a named face have been changed,
4166 because we can't tell which realized faces depend on that face. */
4169 free_all_realized_faces (frame
)
4175 FOR_EACH_FRAME (rest
, frame
)
4176 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4179 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4183 /* Free face cache C and faces in it, including their X resources. */
4187 struct face_cache
*c
;
4191 free_realized_faces (c
);
4193 xfree (c
->faces_by_id
);
4199 /* Cache realized face FACE in face cache C. HASH is the hash value
4200 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4201 collision list of the face hash table of C. This is done because
4202 otherwise lookup_face would find FACE for every charset, even if
4203 faces with the same attributes but for specific charsets exist. */
4206 cache_face (c
, face
, hash
)
4207 struct face_cache
*c
;
4211 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4215 if (face
->fontset
>= 0)
4217 struct face
*last
= c
->buckets
[i
];
4228 c
->buckets
[i
] = face
;
4229 face
->prev
= face
->next
= NULL
;
4235 face
->next
= c
->buckets
[i
];
4237 face
->next
->prev
= face
;
4238 c
->buckets
[i
] = face
;
4241 /* Find a free slot in C->faces_by_id and use the index of the free
4242 slot as FACE->id. */
4243 for (i
= 0; i
< c
->used
; ++i
)
4244 if (c
->faces_by_id
[i
] == NULL
)
4248 /* Maybe enlarge C->faces_by_id. */
4249 if (i
== c
->used
&& c
->used
== c
->size
)
4251 int new_size
= 2 * c
->size
;
4252 int sz
= new_size
* sizeof *c
->faces_by_id
;
4253 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4258 /* Check that FACE got a unique id. */
4263 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4264 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4270 #endif /* GLYPH_DEBUG */
4272 c
->faces_by_id
[i
] = face
;
4278 /* Remove face FACE from cache C. */
4281 uncache_face (c
, face
)
4282 struct face_cache
*c
;
4285 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4288 face
->prev
->next
= face
->next
;
4290 c
->buckets
[i
] = face
->next
;
4293 face
->next
->prev
= face
->prev
;
4295 c
->faces_by_id
[face
->id
] = NULL
;
4296 if (face
->id
== c
->used
)
4301 /* Look up a realized face with face attributes ATTR in the face cache
4302 of frame F. The face will be used to display characters of
4303 CHARSET. CHARSET < 0 means the face will be used to display
4304 unibyte text. The value of face-default-registry is used to choose
4305 a font for the face in that case. Value is the ID of the face
4306 found. If no suitable face is found, realize a new one. */
4309 lookup_face (f
, attr
, charset
)
4314 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4319 xassert (c
!= NULL
);
4320 check_lface_attrs (attr
);
4322 /* Look up ATTR in the face cache. */
4323 hash
= lface_hash (attr
);
4324 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4326 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4327 if (face
->hash
== hash
4328 && (!FRAME_WINDOW_P (f
)
4329 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4330 && lface_equal_p (face
->lface
, attr
))
4333 /* If not found, realize a new face. */
4336 face
= realize_face (c
, attr
, charset
);
4337 cache_face (c
, face
, hash
);
4341 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4343 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4344 #endif /* GLYPH_DEBUG */
4350 /* Return the face id of the realized face for named face SYMBOL on
4351 frame F suitable for displaying characters from CHARSET. CHARSET <
4352 0 means unibyte text. */
4355 lookup_named_face (f
, symbol
, charset
)
4360 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4361 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4362 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4364 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4365 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4366 merge_face_vectors (symbol_attrs
, attrs
);
4367 return lookup_face (f
, attrs
, charset
);
4371 /* Return the ID of the realized ASCII face of Lisp face with ID
4372 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4375 ascii_face_of_lisp_face (f
, lface_id
)
4381 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4383 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4384 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4393 /* Return a face for charset ASCII that is like the face with id
4394 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4395 STEPS < 0 means larger. Value is the id of the face. */
4398 smaller_face (f
, face_id
, steps
)
4402 #ifdef HAVE_X_WINDOWS
4404 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4405 int pt
, last_pt
, last_height
;
4408 struct face
*new_face
;
4410 /* If not called for an X frame, just return the original face. */
4411 if (FRAME_TERMCAP_P (f
))
4414 /* Try in increments of 1/2 pt. */
4415 delta
= steps
< 0 ? 5 : -5;
4416 steps
= abs (steps
);
4418 face
= FACE_FROM_ID (f
, face_id
);
4419 bcopy (face
->lface
, attrs
, sizeof attrs
);
4420 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4421 new_face_id
= face_id
;
4422 last_height
= FONT_HEIGHT (face
->font
);
4426 /* Give up if we cannot find a font within 10pt. */
4427 && abs (last_pt
- pt
) < 100)
4429 /* Look up a face for a slightly smaller/larger font. */
4431 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4432 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4433 new_face
= FACE_FROM_ID (f
, new_face_id
);
4435 /* If height changes, count that as one step. */
4436 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4439 last_height
= FONT_HEIGHT (new_face
->font
);
4446 #else /* not HAVE_X_WINDOWS */
4450 #endif /* not HAVE_X_WINDOWS */
4454 /* Return a face for charset ASCII that is like the face with id
4455 FACE_ID on frame F, but has height HEIGHT. */
4458 face_with_height (f
, face_id
, height
)
4463 #ifdef HAVE_X_WINDOWS
4465 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4467 if (FRAME_TERMCAP_P (f
)
4471 face
= FACE_FROM_ID (f
, face_id
);
4472 bcopy (face
->lface
, attrs
, sizeof attrs
);
4473 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4474 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4475 #endif /* HAVE_X_WINDOWS */
4480 /* Return the face id of the realized face for named face SYMBOL on
4481 frame F suitable for displaying characters from CHARSET (CHARSET <
4482 0 means unibyte text), and use attributes of the face FACE_ID for
4483 attributes that aren't completely specified by SYMBOL. This is
4484 like lookup_named_face, except that the default attributes come
4485 from FACE_ID, not from the default face. FACE_ID is assumed to
4486 be already realized. */
4489 lookup_derived_face (f
, symbol
, charset
, face_id
)
4495 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4496 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4497 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4502 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4503 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4504 merge_face_vectors (symbol_attrs
, attrs
);
4505 return lookup_face (f
, attrs
, charset
);
4510 /***********************************************************************
4512 ***********************************************************************/
4514 DEFUN ("internal-set-font-selection-order",
4515 Finternal_set_font_selection_order
,
4516 Sinternal_set_font_selection_order
, 1, 1, 0,
4517 "Set font selection order for face font selection to ORDER.\n\
4518 ORDER must be a list of length 4 containing the symbols `:width',\n\
4519 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4520 first in ORDER are matched first, e.g. if `:height' appears before\n\
4521 `:weight' in ORDER, font selection first tries to find a font with\n\
4522 a suitable height, and then tries to match the font weight.\n\
4531 CHECK_LIST (order
, 0);
4532 bzero (indices
, sizeof indices
);
4536 CONSP (list
) && i
< DIM (indices
);
4537 list
= XCDR (list
), ++i
)
4539 Lisp_Object attr
= XCAR (list
);
4542 if (EQ (attr
, QCwidth
))
4544 else if (EQ (attr
, QCheight
))
4545 xlfd
= XLFD_POINT_SIZE
;
4546 else if (EQ (attr
, QCweight
))
4548 else if (EQ (attr
, QCslant
))
4553 if (indices
[i
] != 0)
4559 || i
!= DIM (indices
)
4564 signal_error ("Invalid font sort order", order
);
4566 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4568 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4569 free_all_realized_faces (Qnil
);
4576 DEFUN ("internal-set-alternative-font-family-alist",
4577 Finternal_set_alternative_font_family_alist
,
4578 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
4579 "Define alternative font families to try in face font selection.\n\
4580 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4581 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
4582 be found. Value is ALIST.")
4586 CHECK_LIST (alist
, 0);
4587 Vface_alternative_font_family_alist
= alist
;
4588 free_all_realized_faces (Qnil
);
4593 #ifdef HAVE_X_WINDOWS
4595 /* Return the X registry and encoding of font name FONT_NAME on frame F.
4596 Value is nil if not successful. */
4599 deduce_unibyte_registry (f
, font_name
)
4603 struct font_name font
;
4604 Lisp_Object registry
= Qnil
;
4606 font
.name
= STRDUPA (font_name
);
4607 if (split_font_name (f
, &font
, 0))
4611 /* Extract registry and encoding. */
4612 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
4613 + strlen (font
.fields
[XLFD_ENCODING
])
4615 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
4616 strcat (buffer
, "-");
4617 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
4618 registry
= build_string (buffer
);
4625 /* Value is non-zero if FONT is the name of a scalable font. The
4626 X11R6 XLFD spec says that point size, pixel size, and average width
4627 are zero for scalable fonts. Intlfonts contain at least one
4628 scalable font ("*-muleindian-1") for which this isn't true, so we
4629 just test average width. */
4632 font_scalable_p (font
)
4633 struct font_name
*font
;
4635 char *s
= font
->fields
[XLFD_AVGWIDTH
];
4636 return *s
== '0' && *(s
+ 1) == '\0';
4640 /* Value is non-zero if FONT1 is a better match for font attributes
4641 VALUES than FONT2. VALUES is an array of face attribute values in
4642 font sort order. COMPARE_PT_P zero means don't compare point
4646 better_font_p (values
, font1
, font2
, compare_pt_p
)
4648 struct font_name
*font1
, *font2
;
4653 for (i
= 0; i
< 4; ++i
)
4655 int xlfd_idx
= font_sort_order
[i
];
4657 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
4659 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
4660 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
4662 if (delta1
> delta2
)
4664 else if (delta1
< delta2
)
4668 /* The difference may be equal because, e.g., the face
4669 specifies `italic' but we have only `regular' and
4670 `oblique'. Prefer `oblique' in this case. */
4671 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
4672 && font1
->numeric
[xlfd_idx
] > values
[i
]
4673 && font2
->numeric
[xlfd_idx
] < values
[i
])
4685 /* Value is non-zero if FONT is an exact match for face attributes in
4686 SPECIFIED. SPECIFIED is an array of face attribute values in font
4690 exact_face_match_p (specified
, font
)
4692 struct font_name
*font
;
4696 for (i
= 0; i
< 4; ++i
)
4697 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
4704 /* Value is the name of a scaled font, generated from scalable font
4705 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
4706 Value is allocated from heap. */
4709 build_scalable_font_name (f
, font
, specified_pt
)
4711 struct font_name
*font
;
4714 char point_size
[20], pixel_size
[20];
4716 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
4719 /* If scalable font is for a specific resolution, compute
4720 the point size we must specify from the resolution of
4721 the display and the specified resolution of the font. */
4722 if (font
->numeric
[XLFD_RESY
] != 0)
4724 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
4725 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
4730 pixel_value
= resy
/ 720.0 * pt
;
4733 /* Set point size of the font. */
4734 sprintf (point_size
, "%d", (int) pt
);
4735 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
4736 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
4738 /* Set pixel size. */
4739 sprintf (pixel_size
, "%d", pixel_value
);
4740 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
4741 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
4743 /* If font doesn't specify its resolution, use the
4744 resolution of the display. */
4745 if (font
->numeric
[XLFD_RESY
] == 0)
4748 sprintf (buffer
, "%d", (int) resy
);
4749 font
->fields
[XLFD_RESY
] = buffer
;
4750 font
->numeric
[XLFD_RESY
] = resy
;
4753 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
4756 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
4757 sprintf (buffer
, "%d", resx
);
4758 font
->fields
[XLFD_RESX
] = buffer
;
4759 font
->numeric
[XLFD_RESX
] = resx
;
4762 return build_font_name (font
);
4766 /* Value is non-zero if we are allowed to use scalable font FONT. We
4767 can't run a Lisp function here since this function may be called
4768 with input blocked. */
4771 may_use_scalable_font_p (font
, name
)
4772 struct font_name
*font
;
4775 if (EQ (Vscalable_fonts_allowed
, Qt
))
4777 else if (CONSP (Vscalable_fonts_allowed
))
4779 Lisp_Object tail
, regexp
;
4781 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
4783 regexp
= XCAR (tail
);
4784 if (STRINGP (regexp
)
4785 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
4793 #endif /* SCALABLE_FONTS != 0 */
4796 /* Return the name of the best matching font for face attributes
4797 ATTRS in the array of font_name structures FONTS which contains
4798 NFONTS elements. Value is a font name which is allocated from
4799 the heap. FONTS is freed by this function. */
4802 best_matching_font (f
, attrs
, fonts
, nfonts
)
4805 struct font_name
*fonts
;
4809 struct font_name
*best
;
4817 /* Make specified font attributes available in `specified',
4818 indexed by sort order. */
4819 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
4821 int xlfd_idx
= font_sort_order
[i
];
4823 if (xlfd_idx
== XLFD_SWIDTH
)
4824 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
4825 else if (xlfd_idx
== XLFD_POINT_SIZE
)
4826 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4827 else if (xlfd_idx
== XLFD_WEIGHT
)
4828 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
4829 else if (xlfd_idx
== XLFD_SLANT
)
4830 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
4840 /* Start with the first non-scalable font in the list. */
4841 for (i
= 0; i
< nfonts
; ++i
)
4842 if (!font_scalable_p (fonts
+ i
))
4845 /* Find the best match among the non-scalable fonts. */
4850 for (i
= 1; i
< nfonts
; ++i
)
4851 if (!font_scalable_p (fonts
+ i
)
4852 && better_font_p (specified
, fonts
+ i
, best
, 1))
4856 exact_p
= exact_face_match_p (specified
, best
);
4865 /* Unless we found an exact match among non-scalable fonts, see if
4866 we can find a better match among scalable fonts. */
4869 /* A scalable font is better if
4871 1. its weight, slant, swidth attributes are better, or.
4873 2. the best non-scalable font doesn't have the required
4874 point size, and the scalable fonts weight, slant, swidth
4877 int non_scalable_has_exact_height_p
;
4879 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
4880 non_scalable_has_exact_height_p
= 1;
4882 non_scalable_has_exact_height_p
= 0;
4884 for (i
= 0; i
< nfonts
; ++i
)
4885 if (font_scalable_p (fonts
+ i
))
4888 || better_font_p (specified
, fonts
+ i
, best
, 0)
4889 || (!non_scalable_has_exact_height_p
4890 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
4895 if (font_scalable_p (best
))
4896 font_name
= build_scalable_font_name (f
, best
, pt
);
4898 font_name
= build_font_name (best
);
4900 #else /* !SCALABLE_FONTS */
4902 /* Find the best non-scalable font. */
4905 for (i
= 1; i
< nfonts
; ++i
)
4907 xassert (!font_scalable_p (fonts
+ i
));
4908 if (better_font_p (specified
, fonts
+ i
, best
, 1))
4912 font_name
= build_font_name (best
);
4914 #endif /* !SCALABLE_FONTS */
4916 /* Free font_name structures. */
4917 free_font_names (fonts
, nfonts
);
4923 /* Try to get a list of fonts on frame F with font family FAMILY and
4924 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
4925 of font_name structures for the fonts matched. Value is the number
4929 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
4932 char *pattern
, *family
, *registry
;
4933 struct font_name
**fonts
;
4938 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
4940 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
4946 /* Try alternative font families from
4947 Vface_alternative_font_family_alist. */
4948 alter
= Fassoc (build_string (family
),
4949 Vface_alternative_font_family_alist
);
4951 for (alter
= XCDR (alter
);
4952 CONSP (alter
) && nfonts
== 0;
4953 alter
= XCDR (alter
))
4955 if (STRINGP (XCAR (alter
)))
4957 family
= LSTRDUPA (XCAR (alter
));
4958 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
4962 /* Try font family of the default face or "fixed". */
4965 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4967 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
4970 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
4973 /* Try any family with the given registry. */
4975 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
4982 /* Return the registry and encoding pattern that fonts for CHARSET
4983 should match. Value is allocated from the heap. */
4986 x_charset_registry (charset
)
4989 Lisp_Object prop
, charset_plist
;
4992 /* Get registry and encoding from the charset's plist. */
4993 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
4994 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
4998 if (index (XSTRING (prop
)->data
, '-'))
4999 registry
= xstrdup (XSTRING (prop
)->data
);
5002 /* If registry doesn't contain a `-', make it a pattern. */
5003 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5004 strcpy (registry
, XSTRING (prop
)->data
);
5005 strcat (registry
, "*-*");
5008 else if (STRINGP (Vface_default_registry
))
5009 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5011 registry
= xstrdup ("iso8859-1");
5017 /* Return the fontset id of the fontset name or alias name given by
5018 the family attribute of ATTRS on frame F. Value is -1 if the
5019 family attribute of ATTRS doesn't name a fontset. */
5022 face_fontset (f
, attrs
)
5026 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5029 name
= Fquery_fontset (name
, Qnil
);
5033 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5039 /* Get the font to use for the face realizing the fully-specified Lisp
5040 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5041 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5042 in this case. Value is the font name which is allocated from the
5043 heap (which means that it must be freed eventually). */
5046 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5050 Lisp_Object unibyte_registry
;
5052 struct font_name
*fonts
;
5056 /* ATTRS must be fully-specified. */
5057 xassert (lface_fully_specified_p (attrs
));
5059 if (STRINGP (unibyte_registry
))
5060 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5062 registry
= x_charset_registry (charset
);
5064 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5066 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5070 /* Choose a font to use on frame F to display CHARSET using FONTSET
5071 with Lisp face attributes specified by ATTRS. CHARSET may be any
5072 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
5073 unibyte text. If the fontset doesn't contain a font pattern for
5074 charset, use the pattern for CHARSET_ASCII. Value is the font name
5075 which is allocated from the heap and must be freed by the caller. */
5078 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5081 int fontset
, charset
;
5084 char *font_name
= NULL
;
5085 struct fontset_info
*fontset_info
;
5086 struct font_name
*fonts
;
5089 xassert (charset
!= CHARSET_COMPOSITION
);
5090 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5092 /* For unibyte text, use the ASCII font of the fontset. Using the
5093 ASCII font seems to be the most reasonable thing we can do in
5096 charset
= CHARSET_ASCII
;
5098 /* Get the font name pattern to use for CHARSET from the fontset. */
5099 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5100 pattern
= fontset_info
->fontname
[charset
];
5102 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5105 /* Get a list of fonts matching that pattern and choose the
5106 best match for the specified face attributes from it. */
5107 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5108 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5112 #endif /* HAVE_X_WINDOWS */
5116 /***********************************************************************
5118 ***********************************************************************/
5120 /* Realize basic faces on frame F. Value is zero if frame parameters
5121 of F don't contain enough information needed to realize the default
5125 realize_basic_faces (f
)
5130 if (realize_default_face (f
))
5132 realize_named_face (f
, Qmodeline
, MODE_LINE_FACE_ID
);
5133 realize_named_face (f
, Qtoolbar
, TOOLBAR_FACE_ID
);
5134 realize_named_face (f
, Qbitmap_area
, BITMAP_AREA_FACE_ID
);
5135 realize_named_face (f
, Qtop_line
, TOP_LINE_FACE_ID
);
5143 /* Realize the default face on frame F. If the face is not fully
5144 specified, make it fully-specified. Attributes of the default face
5145 that are not explicitly specified are taken from frame parameters. */
5148 realize_default_face (f
)
5151 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5153 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5154 Lisp_Object unibyte_registry
;
5155 Lisp_Object frame_font
;
5159 /* If the `default' face is not yet known, create it. */
5160 lface
= lface_from_face_name (f
, Qdefault
, 0);
5164 XSETFRAME (frame
, f
);
5165 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5168 #ifdef HAVE_X_WINDOWS
5171 /* Set frame_font to the value of the `font' frame parameter. */
5172 frame_font
= Fassq (Qfont
, f
->param_alist
);
5173 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5174 frame_font
= XCDR (frame_font
);
5176 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5179 /* If frame_font is a fontset name, don't use that for
5180 determining font-related attributes of the default face
5181 because it is just an artificial name. Use the ASCII font of
5182 the fontset, instead. */
5183 struct font_info
*font_info
;
5184 struct font_name font
;
5187 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5191 /* Set weight etc. from the ASCII font. */
5192 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0))
5195 /* Remember registry and encoding of the frame font. */
5196 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5197 if (STRINGP (unibyte_registry
))
5198 Vface_default_registry
= unibyte_registry
;
5200 Vface_default_registry
= build_string ("iso8859-1");
5202 /* But set the family to the fontset alias name. Implementation
5203 note: When a font is passed to Emacs via `-fn FONT', a
5204 fontset is created in `x-win.el' whose name ends in
5205 `fontset-startup'. This fontset has an alias name that is
5206 equal to frame_font. */
5207 xassert (STRINGP (frame_font
));
5208 font
.name
= LSTRDUPA (frame_font
);
5210 if (!split_font_name (f
, &font
, 1)
5211 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5212 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5213 LFACE_FAMILY (lface
) = frame_font
;
5217 /* Frame parameters contain a real font. Fill default face
5218 attributes from that font. */
5219 if (!set_lface_from_font_name (f
, lface
,
5220 XSTRING (frame_font
)->data
, 0))
5223 /* Remember registry and encoding of the frame font. */
5225 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5226 if (STRINGP (unibyte_registry
))
5227 Vface_default_registry
= unibyte_registry
;
5229 Vface_default_registry
= build_string ("iso8859-1");
5232 #endif /* HAVE_X_WINDOWS */
5234 if (!FRAME_WINDOW_P (f
))
5236 LFACE_FAMILY (lface
) = build_string ("default");
5237 LFACE_SWIDTH (lface
) = Qnormal
;
5238 LFACE_HEIGHT (lface
) = make_number (1);
5239 LFACE_WEIGHT (lface
) = Qnormal
;
5240 LFACE_SLANT (lface
) = Qnormal
;
5243 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5244 LFACE_UNDERLINE (lface
) = Qnil
;
5246 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5247 LFACE_OVERLINE (lface
) = Qnil
;
5249 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5250 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5252 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5253 LFACE_BOX (lface
) = Qnil
;
5255 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5256 LFACE_INVERSE (lface
) = Qnil
;
5258 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5260 /* This function is called so early that colors are not yet
5261 set in the frame parameter list. */
5262 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5264 if (CONSP (color
) && STRINGP (XCDR (color
)))
5265 LFACE_FOREGROUND (lface
) = XCDR (color
);
5266 else if (FRAME_X_P (f
))
5268 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5269 /* Frame parameters for terminal frames usually don't contain
5270 a color. Use an empty string to indicate that the face
5271 should use the (unknown) default color of the terminal. */
5272 LFACE_FOREGROUND (lface
) = build_string ("");
5277 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5279 /* This function is called so early that colors are not yet
5280 set in the frame parameter list. */
5281 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5282 if (CONSP (color
) && STRINGP (XCDR (color
)))
5283 LFACE_BACKGROUND (lface
) = XCDR (color
);
5284 else if (FRAME_X_P (f
))
5286 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5287 /* Frame parameters for terminal frames usually don't contain
5288 a color. Use an empty string to indicate that the face
5289 should use the (unknown) default color of the terminal. */
5290 LFACE_BACKGROUND (lface
) = build_string ("");
5295 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5296 LFACE_STIPPLE (lface
) = Qnil
;
5298 /* Realize the face; it must be fully-specified now. */
5299 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5300 check_lface (lface
);
5301 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5302 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5304 /* Remove the former default face. */
5305 if (c
->used
> DEFAULT_FACE_ID
)
5307 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5308 uncache_face (c
, default_face
);
5309 free_realized_face (f
, default_face
);
5312 /* Insert the new default face. */
5313 cache_face (c
, face
, lface_hash (attrs
));
5314 xassert (face
->id
== DEFAULT_FACE_ID
);
5319 /* Realize basic faces other than the default face in face cache C.
5320 SYMBOL is the face name, ID is the face id the realized face must
5321 have. The default face must have been realized already. */
5324 realize_named_face (f
, symbol
, id
)
5329 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5330 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5331 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5332 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5333 struct face
*new_face
;
5335 /* The default face must exist and be fully specified. */
5336 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5337 check_lface_attrs (attrs
);
5338 xassert (lface_fully_specified_p (attrs
));
5340 /* If SYMBOL isn't know as a face, create it. */
5344 XSETFRAME (frame
, f
);
5345 lface
= Finternal_make_lisp_face (symbol
, frame
);
5348 /* Merge SYMBOL's face with the default face. */
5349 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5350 merge_face_vectors (symbol_attrs
, attrs
);
5352 /* Realize the face. */
5353 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5355 /* Remove the former face. */
5358 struct face
*old_face
= c
->faces_by_id
[id
];
5359 uncache_face (c
, old_face
);
5360 free_realized_face (f
, old_face
);
5363 /* Insert the new face. */
5364 cache_face (c
, new_face
, lface_hash (attrs
));
5365 xassert (new_face
->id
== id
);
5369 /* Realize the fully-specified face with attributes ATTRS in face
5370 cache C for character set CHARSET or for unibyte text if CHARSET <
5371 0. Value is a pointer to the newly created realized face. */
5373 static struct face
*
5374 realize_face (c
, attrs
, charset
)
5375 struct face_cache
*c
;
5381 /* LFACE must be fully specified. */
5382 xassert (c
!= NULL
);
5383 check_lface_attrs (attrs
);
5385 if (FRAME_X_P (c
->f
))
5386 face
= realize_x_face (c
, attrs
, charset
);
5387 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5388 face
= realize_tty_face (c
, attrs
, charset
);
5396 /* Realize the fully-specified face with attributes ATTRS in face
5397 cache C for character set CHARSET or for unibyte text if CHARSET <
5398 0. Do it for X frame C->f. Value is a pointer to the newly
5399 created realized face. */
5401 static struct face
*
5402 realize_x_face (c
, attrs
, charset
)
5403 struct face_cache
*c
;
5407 #ifdef HAVE_X_WINDOWS
5408 struct face
*face
, *default_face
;
5409 struct frame
*f
= c
->f
;
5410 Lisp_Object stipple
, overline
, strike_through
, box
;
5411 Lisp_Object unibyte_registry
;
5412 struct gcpro gcpro1
;
5414 xassert (FRAME_X_P (f
));
5416 /* If realizing a face for use in unibyte text, get the X registry
5417 and encoding to use from Vface_default_registry. */
5419 unibyte_registry
= (STRINGP (Vface_default_registry
)
5420 ? Vface_default_registry
5421 : build_string ("iso8859-1"));
5423 unibyte_registry
= Qnil
;
5424 GCPRO1 (unibyte_registry
);
5426 /* Allocate a new realized face. */
5427 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5429 /* Determine the font to use. Most of the time, the font will be
5430 the same as the font of the default face, so try that first. */
5431 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5433 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5434 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5436 face
->font
= default_face
->font
;
5437 face
->fontset
= default_face
->fontset
;
5438 face
->font_info_id
= default_face
->font_info_id
;
5439 face
->font_name
= default_face
->font_name
;
5440 face
->registry
= default_face
->registry
;
5442 else if (charset
>= 0)
5444 /* For all charsets except CHARSET_COMPOSITION, we use our own
5445 font selection functions to choose a best matching font for
5446 the specified face attributes. If the face specifies a
5447 fontset alias name, the fontset determines the font name
5448 pattern, otherwise we construct a font pattern from face
5449 attributes and charset.
5451 If charset is CHARSET_COMPOSITION, we always construct a face
5452 with a fontset, even if the face doesn't specify a fontset alias
5453 (we use fontset-standard in that case). When the composite
5454 character is displayed in xterm.c, a suitable concrete font is
5455 loaded in x_get_char_font_and_encoding. */
5457 char *font_name
= NULL
;
5458 int fontset
= face_fontset (f
, attrs
);
5460 if (charset
== CHARSET_COMPOSITION
)
5461 fontset
= max (0, fontset
);
5462 else if (fontset
< 0)
5463 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5466 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5470 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5475 /* Unibyte case, and font is not equal to that of the default
5476 face. UNIBYTE_REGISTRY is the X registry and encoding the
5477 font should have. What is a reasonable thing to do if the
5478 user specified a fontset alias name for the face in this
5479 case? We choose a font by taking the ASCII font of the
5480 fontset, but using UNIBYTE_REGISTRY for its registry and
5483 char *font_name
= NULL
;
5484 int fontset
= face_fontset (f
, attrs
);
5487 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5489 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5491 load_face_font_or_fontset (f
, face
, font_name
, -1);
5495 /* Load colors, and set remaining attributes. */
5497 load_face_colors (f
, face
, attrs
);
5500 box
= attrs
[LFACE_BOX_INDEX
];
5503 /* A simple box of line width 1 drawn in color given by
5505 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5507 face
->box
= FACE_SIMPLE_BOX
;
5508 face
->box_line_width
= 1;
5510 else if (INTEGERP (box
))
5512 /* Simple box of specified line width in foreground color of the
5514 xassert (XINT (box
) > 0);
5515 face
->box
= FACE_SIMPLE_BOX
;
5516 face
->box_line_width
= XFASTINT (box
);
5517 face
->box_color
= face
->foreground
;
5518 face
->box_color_defaulted_p
= 1;
5520 else if (CONSP (box
))
5522 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5523 being one of `raised' or `sunken'. */
5524 face
->box
= FACE_SIMPLE_BOX
;
5525 face
->box_color
= face
->foreground
;
5526 face
->box_color_defaulted_p
= 1;
5527 face
->box_line_width
= 1;
5531 Lisp_Object keyword
, value
;
5533 keyword
= XCAR (box
);
5541 if (EQ (keyword
, QCline_width
))
5543 if (INTEGERP (value
) && XINT (value
) > 0)
5544 face
->box_line_width
= XFASTINT (value
);
5546 else if (EQ (keyword
, QCcolor
))
5548 if (STRINGP (value
))
5550 face
->box_color
= load_color (f
, face
, value
,
5552 face
->use_box_color_for_shadows_p
= 1;
5555 else if (EQ (keyword
, QCstyle
))
5557 if (EQ (value
, Qreleased_button
))
5558 face
->box
= FACE_RAISED_BOX
;
5559 else if (EQ (value
, Qpressed_button
))
5560 face
->box
= FACE_SUNKEN_BOX
;
5565 /* Text underline, overline, strike-through. */
5567 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5569 /* Use default color (same as foreground color). */
5570 face
->underline_p
= 1;
5571 face
->underline_defaulted_p
= 1;
5572 face
->underline_color
= 0;
5574 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5576 /* Use specified color. */
5577 face
->underline_p
= 1;
5578 face
->underline_defaulted_p
= 0;
5579 face
->underline_color
5580 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5581 LFACE_UNDERLINE_INDEX
);
5583 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5585 face
->underline_p
= 0;
5586 face
->underline_defaulted_p
= 0;
5587 face
->underline_color
= 0;
5590 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5591 if (STRINGP (overline
))
5593 face
->overline_color
5594 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5595 LFACE_OVERLINE_INDEX
);
5596 face
->overline_p
= 1;
5598 else if (EQ (overline
, Qt
))
5600 face
->overline_color
= face
->foreground
;
5601 face
->overline_color_defaulted_p
= 1;
5602 face
->overline_p
= 1;
5605 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5606 if (STRINGP (strike_through
))
5608 face
->strike_through_color
5609 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5610 LFACE_STRIKE_THROUGH_INDEX
);
5611 face
->strike_through_p
= 1;
5613 else if (EQ (strike_through
, Qt
))
5615 face
->strike_through_color
= face
->foreground
;
5616 face
->strike_through_color_defaulted_p
= 1;
5617 face
->strike_through_p
= 1;
5620 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5621 if (!NILP (stipple
))
5622 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5625 xassert (face
->fontset
< 0 || face
->charset
== CHARSET_COMPOSITION
);
5626 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
5628 #endif /* HAVE_X_WINDOWS */
5632 /* Realize the fully-specified face with attributes ATTRS in face
5633 cache C for character set CHARSET or for unibyte text if CHARSET <
5634 0. Do it for TTY frame C->f. Value is a pointer to the newly
5635 created realized face. */
5637 static struct face
*
5638 realize_tty_face (c
, attrs
, charset
)
5639 struct face_cache
*c
;
5647 /* Frame must be a termcap frame. */
5648 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
5650 /* Allocate a new realized face. */
5651 face
= make_realized_face (attrs
, charset
, Qnil
);
5652 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
5654 /* Map face attributes to TTY appearances. We map slant to
5655 dimmed text because we want italic text to appear differently
5656 and because dimmed text is probably used infrequently. */
5657 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5658 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5660 if (weight
> XLFD_WEIGHT_MEDIUM
)
5661 face
->tty_bold_p
= 1;
5662 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
5663 face
->tty_dim_p
= 1;
5664 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5665 face
->tty_underline_p
= 1;
5666 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5667 face
->tty_reverse_p
= 1;
5669 /* Map color names to color indices. */
5670 face
->foreground
= face
->background
= FACE_TTY_DEFAULT_COLOR
;
5672 color
= attrs
[LFACE_FOREGROUND_INDEX
];
5673 if (XSTRING (color
)->size
5674 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5676 face
->foreground
= XINT (XCDR (color
));
5679 if (FRAME_MSDOS_P (c
->f
) && face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
5681 face
->foreground
= load_color (c
->f
, face
,
5682 attrs
[LFACE_FOREGROUND_INDEX
],
5683 LFACE_FOREGROUND_INDEX
);
5684 /* If the foreground of the default face is the default color,
5685 use the foreground color defined by the frame. */
5686 if (face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
5688 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
5689 attrs
[LFACE_FOREGROUND_INDEX
] =
5690 build_string (msdos_stdcolor_name (face
->foreground
));
5695 color
= attrs
[LFACE_BACKGROUND_INDEX
];
5696 if (XSTRING (color
)->size
5697 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5699 face
->background
= XINT (XCDR (color
));
5702 if (FRAME_MSDOS_P (c
->f
) && face
->background
== FACE_TTY_DEFAULT_COLOR
)
5704 face
->background
= load_color (c
->f
, face
,
5705 attrs
[LFACE_BACKGROUND_INDEX
],
5706 LFACE_BACKGROUND_INDEX
);
5707 /* If the background of the default face is the default color,
5708 use the background color defined by the frame. */
5709 if (face
->background
== FACE_TTY_DEFAULT_COLOR
)
5711 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
5712 attrs
[LFACE_BACKGROUND_INDEX
] =
5713 build_string (msdos_stdcolor_name (face
->background
));
5717 /* Swap colors if face is inverse-video. */
5718 if (face
->tty_reverse_p
)
5720 unsigned long tem
= face
->foreground
;
5722 face
->foreground
= face
->background
;
5723 face
->background
= tem
;
5731 DEFUN ("face-register-tty-color", Fface_register_tty_color
,
5732 Sface_register_tty_color
, 2, 2, 0,
5733 "Say that COLOR is color number NUMBER on the terminal.\n\
5734 COLOR is a string, the color name. Value is COLOR.")
5736 Lisp_Object color
, number
;
5740 CHECK_STRING (color
, 0);
5741 CHECK_NUMBER (number
, 1);
5742 entry
= Fassoc (color
, Vface_tty_color_alist
);
5744 Vface_tty_color_alist
= Fcons (Fcons (color
, number
),
5745 Vface_tty_color_alist
);
5747 Fsetcdr (entry
, number
);
5752 DEFUN ("face-clear-tty-colors", Fface_clear_tty_colors
,
5753 Sface_clear_tty_colors
, 0, 0, 0,
5754 "Unregister all registered tty colors.")
5757 return Vface_tty_color_alist
= Qnil
;
5761 DEFUN ("tty-defined-colors", Ftty_defined_colors
,
5762 Stty_defined_colors
, 0, 0, 0,
5763 "Return a list of registered tty colors.")
5766 Lisp_Object list
, colors
;
5769 for (list
= Vface_tty_color_alist
; CONSP (list
); list
= XCDR (list
))
5770 colors
= Fcons (XCAR (XCAR (list
)), colors
);
5777 /***********************************************************************
5779 ***********************************************************************/
5781 /* Return the ID of the face to use to display character CH with face
5782 property PROP on frame F in current_buffer. */
5785 compute_char_face (f
, ch
, prop
)
5791 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
5793 : CHAR_CHARSET (ch
));
5796 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
5799 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5800 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5801 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5802 merge_face_vector_with_property (f
, attrs
, prop
);
5803 face_id
= lookup_face (f
, attrs
, charset
);
5810 /* Return the face ID associated with buffer position POS for
5811 displaying ASCII characters. Return in *ENDPTR the position at
5812 which a different face is needed, as far as text properties and
5813 overlays are concerned. W is a window displaying current_buffer.
5815 REGION_BEG, REGION_END delimit the region, so it can be
5818 LIMIT is a position not to scan beyond. That is to limit the time
5819 this function can take.
5821 If MOUSE is non-zero, use the character's mouse-face, not its face.
5823 The face returned is suitable for displaying CHARSET_ASCII if
5824 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
5825 the face is suitable for displaying unibyte text. */
5828 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
5829 endptr
, limit
, mouse
)
5832 int region_beg
, region_end
;
5837 struct frame
*f
= XFRAME (w
->frame
);
5838 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5839 Lisp_Object prop
, position
;
5841 Lisp_Object
*overlay_vec
;
5844 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5845 Lisp_Object limit1
, end
;
5846 struct face
*default_face
;
5847 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
5849 /* W must display the current buffer. We could write this function
5850 to use the frame and buffer of W, but right now it doesn't. */
5851 /* xassert (XBUFFER (w->buffer) == current_buffer); */
5853 XSETFRAME (frame
, f
);
5854 XSETFASTINT (position
, pos
);
5857 if (pos
< region_beg
&& region_beg
< endpos
)
5858 endpos
= region_beg
;
5860 /* Get the `face' or `mouse_face' text property at POS, and
5861 determine the next position at which the property changes. */
5862 prop
= Fget_text_property (position
, propname
, w
->buffer
);
5863 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5864 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
5866 endpos
= XINT (end
);
5868 /* Look at properties from overlays. */
5873 /* First try with room for 40 overlays. */
5875 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
5876 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
5877 &next_overlay
, NULL
);
5879 /* If there are more than 40, make enough space for all, and try
5881 if (noverlays
> len
)
5884 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
5885 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
5886 &next_overlay
, NULL
);
5889 if (next_overlay
< endpos
)
5890 endpos
= next_overlay
;
5895 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5897 /* Optimize common cases where we can use the default face. */
5900 && !(pos
>= region_beg
&& pos
< region_end
)
5902 || !FRAME_WINDOW_P (f
)
5903 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
5904 return DEFAULT_FACE_ID
;
5906 /* Begin with attributes from the default face. */
5907 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5909 /* Merge in attributes specified via text properties. */
5911 merge_face_vector_with_property (f
, attrs
, prop
);
5913 /* Now merge the overlay data. */
5914 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
5915 for (i
= 0; i
< noverlays
; i
++)
5920 prop
= Foverlay_get (overlay_vec
[i
], propname
);
5922 merge_face_vector_with_property (f
, attrs
, prop
);
5924 oend
= OVERLAY_END (overlay_vec
[i
]);
5925 oendpos
= OVERLAY_POSITION (oend
);
5926 if (oendpos
< endpos
)
5930 /* If in the region, merge in the region face. */
5931 if (pos
>= region_beg
&& pos
< region_end
)
5933 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
5934 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
5936 if (region_end
< endpos
)
5937 endpos
= region_end
;
5942 /* Look up a realized face with the given face attributes,
5943 or realize a new one. Charset is ignored for tty frames. */
5944 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
5948 /* Compute the face at character position POS in Lisp string STRING on
5949 window W, for charset CHARSET_ASCII.
5951 If STRING is an overlay string, it comes from position BUFPOS in
5952 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
5953 not an overlay string. W must display the current buffer.
5954 REGION_BEG and REGION_END give the start and end positions of the
5955 region; both are -1 if no region is visible. BASE_FACE_ID is the
5956 id of the basic face to merge with. It is usually equal to
5957 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or TOP_LINE_FACE_ID
5958 for strings displayed in the mode or top line.
5960 Set *ENDPTR to the next position where to check for faces in
5961 STRING; -1 if the face is constant from POS to the end of the
5964 Value is the id of the face to use. The face returned is suitable
5965 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
5966 the face is suitable for displaying unibyte text. */
5969 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
5970 region_end
, endptr
, base_face_id
)
5974 int region_beg
, region_end
;
5976 enum face_id base_face_id
;
5978 Lisp_Object prop
, position
, end
, limit
;
5979 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
5980 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5981 struct face
*base_face
;
5982 int multibyte_p
= STRING_MULTIBYTE (string
);
5984 /* Get the value of the face property at the current position within
5985 STRING. Value is nil if there is no face property. */
5986 XSETFASTINT (position
, pos
);
5987 prop
= Fget_text_property (position
, Qface
, string
);
5989 /* Get the next position at which to check for faces. Value of end
5990 is nil if face is constant all the way to the end of the string.
5991 Otherwise it is a string position where to check faces next.
5992 Limit is the maximum position up to which to check for property
5993 changes in Fnext_single_property_change. Strings are usually
5994 short, so set the limit to the end of the string. */
5995 XSETFASTINT (limit
, XSTRING (string
)->size
);
5996 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
5998 *endptr
= XFASTINT (end
);
6002 base_face
= FACE_FROM_ID (f
, base_face_id
);
6003 xassert (base_face
);
6005 /* Optimize the default case that there is no face property and we
6006 are not in the region. */
6008 && (base_face_id
!= DEFAULT_FACE_ID
6009 /* BUFPOS <= 0 means STRING is not an overlay string, so
6010 that the region doesn't have to be taken into account. */
6012 || bufpos
< region_beg
6013 || bufpos
>= region_end
)
6015 /* We can't realize faces for different charsets differently
6016 if we don't have fonts, so we can stop here if not working
6017 on a window-system frame. */
6018 || !FRAME_WINDOW_P (f
)
6019 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6020 return base_face
->id
;
6022 /* Begin with attributes from the base face. */
6023 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6025 /* Merge in attributes specified via text properties. */
6027 merge_face_vector_with_property (f
, attrs
, prop
);
6029 /* If in the region, merge in the region face. */
6031 && bufpos
>= region_beg
6032 && bufpos
< region_end
)
6034 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6035 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6038 /* Look up a realized face with the given face attributes,
6039 or realize a new one. */
6040 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6045 /***********************************************************************
6047 ***********************************************************************/
6051 /* Print the contents of the realized face FACE to stderr. */
6054 dump_realized_face (face
)
6057 fprintf (stderr
, "ID: %d\n", face
->id
);
6058 #ifdef HAVE_X_WINDOWS
6059 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6061 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6063 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6064 fprintf (stderr
, "background: 0x%lx (%s)\n",
6066 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6067 fprintf (stderr
, "font_name: %s (%s)\n",
6069 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6070 #ifdef HAVE_X_WINDOWS
6071 fprintf (stderr
, "font = %p\n", face
->font
);
6073 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6074 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6075 fprintf (stderr
, "underline: %d (%s)\n",
6077 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6078 fprintf (stderr
, "hash: %d\n", face
->hash
);
6079 fprintf (stderr
, "charset: %d\n", face
->charset
);
6083 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6091 fprintf (stderr
, "font selection order: ");
6092 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6093 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6094 fprintf (stderr
, "\n");
6096 fprintf (stderr
, "alternative fonts: ");
6097 debug_print (Vface_alternative_font_family_alist
);
6098 fprintf (stderr
, "\n");
6100 for (i
= 0; i
< FRAME_FACE_CACHE (selected_frame
)->used
; ++i
)
6101 Fdump_face (make_number (i
));
6106 CHECK_NUMBER (n
, 0);
6107 face
= FACE_FROM_ID (selected_frame
, XINT (n
));
6109 error ("Not a valid face");
6110 dump_realized_face (face
);
6117 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6121 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6122 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6123 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6127 #endif /* GLYPH_DEBUG != 0 */
6131 /***********************************************************************
6133 ***********************************************************************/
6138 Qface
= intern ("face");
6140 Qpixmap_spec_p
= intern ("pixmap-spec-p");
6141 staticpro (&Qpixmap_spec_p
);
6143 /* Lisp face attribute keywords. */
6144 QCfamily
= intern (":family");
6145 staticpro (&QCfamily
);
6146 QCheight
= intern (":height");
6147 staticpro (&QCheight
);
6148 QCweight
= intern (":weight");
6149 staticpro (&QCweight
);
6150 QCslant
= intern (":slant");
6151 staticpro (&QCslant
);
6152 QCunderline
= intern (":underline");
6153 staticpro (&QCunderline
);
6154 QCinverse_video
= intern (":inverse-video");
6155 staticpro (&QCinverse_video
);
6156 QCreverse_video
= intern (":reverse-video");
6157 staticpro (&QCreverse_video
);
6158 QCforeground
= intern (":foreground");
6159 staticpro (&QCforeground
);
6160 QCbackground
= intern (":background");
6161 staticpro (&QCbackground
);
6162 QCstipple
= intern (":stipple");;
6163 staticpro (&QCstipple
);
6164 QCwidth
= intern (":width");
6165 staticpro (&QCwidth
);
6166 QCfont
= intern (":font");
6167 staticpro (&QCfont
);
6168 QCbold
= intern (":bold");
6169 staticpro (&QCbold
);
6170 QCitalic
= intern (":italic");
6171 staticpro (&QCitalic
);
6172 QCoverline
= intern (":overline");
6173 staticpro (&QCoverline
);
6174 QCstrike_through
= intern (":strike-through");
6175 staticpro (&QCstrike_through
);
6176 QCbox
= intern (":box");
6179 /* Symbols used for Lisp face attribute values. */
6180 QCcolor
= intern (":color");
6181 staticpro (&QCcolor
);
6182 QCline_width
= intern (":line-width");
6183 staticpro (&QCline_width
);
6184 QCstyle
= intern (":style");
6185 staticpro (&QCstyle
);
6186 Qreleased_button
= intern ("released-button");
6187 staticpro (&Qreleased_button
);
6188 Qpressed_button
= intern ("pressed-button");
6189 staticpro (&Qpressed_button
);
6190 Qnormal
= intern ("normal");
6191 staticpro (&Qnormal
);
6192 Qultra_light
= intern ("ultra-light");
6193 staticpro (&Qultra_light
);
6194 Qextra_light
= intern ("extra-light");
6195 staticpro (&Qextra_light
);
6196 Qlight
= intern ("light");
6197 staticpro (&Qlight
);
6198 Qsemi_light
= intern ("semi-light");
6199 staticpro (&Qsemi_light
);
6200 Qsemi_bold
= intern ("semi-bold");
6201 staticpro (&Qsemi_bold
);
6202 Qbold
= intern ("bold");
6204 Qextra_bold
= intern ("extra-bold");
6205 staticpro (&Qextra_bold
);
6206 Qultra_bold
= intern ("ultra-bold");
6207 staticpro (&Qultra_bold
);
6208 Qoblique
= intern ("oblique");
6209 staticpro (&Qoblique
);
6210 Qitalic
= intern ("italic");
6211 staticpro (&Qitalic
);
6212 Qreverse_oblique
= intern ("reverse-oblique");
6213 staticpro (&Qreverse_oblique
);
6214 Qreverse_italic
= intern ("reverse-italic");
6215 staticpro (&Qreverse_italic
);
6216 Qultra_condensed
= intern ("ultra-condensed");
6217 staticpro (&Qultra_condensed
);
6218 Qextra_condensed
= intern ("extra-condensed");
6219 staticpro (&Qextra_condensed
);
6220 Qcondensed
= intern ("condensed");
6221 staticpro (&Qcondensed
);
6222 Qsemi_condensed
= intern ("semi-condensed");
6223 staticpro (&Qsemi_condensed
);
6224 Qsemi_expanded
= intern ("semi-expanded");
6225 staticpro (&Qsemi_expanded
);
6226 Qexpanded
= intern ("expanded");
6227 staticpro (&Qexpanded
);
6228 Qextra_expanded
= intern ("extra-expanded");
6229 staticpro (&Qextra_expanded
);
6230 Qultra_expanded
= intern ("ultra-expanded");
6231 staticpro (&Qultra_expanded
);
6232 Qbackground_color
= intern ("background-color");
6233 staticpro (&Qbackground_color
);
6234 Qforeground_color
= intern ("foreground-color");
6235 staticpro (&Qforeground_color
);
6236 Qunspecified
= intern ("unspecified");
6237 staticpro (&Qunspecified
);
6239 Qx_charset_registry
= intern ("x-charset-registry");
6240 staticpro (&Qx_charset_registry
);
6241 Qdefault
= intern ("default");
6242 staticpro (&Qdefault
);
6243 Qmodeline
= intern ("modeline");
6244 staticpro (&Qmodeline
);
6245 Qtoolbar
= intern ("toolbar");
6246 staticpro (&Qtoolbar
);
6247 Qregion
= intern ("region");
6248 staticpro (&Qregion
);
6249 Qbitmap_area
= intern ("bitmap-area");
6250 staticpro (&Qbitmap_area
);
6251 Qtop_line
= intern ("top-line");
6252 staticpro (&Qtop_line
);
6254 defsubr (&Sinternal_make_lisp_face
);
6255 defsubr (&Sinternal_lisp_face_p
);
6256 defsubr (&Sinternal_set_lisp_face_attribute
);
6257 #ifdef HAVE_X_WINDOWS
6258 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6259 defsubr (&Sface_color_gray_p
);
6260 defsubr (&Sface_color_supported_p
);
6262 defsubr (&Sinternal_get_lisp_face_attribute
);
6263 defsubr (&Sinternal_lisp_face_attribute_values
);
6264 defsubr (&Sinternal_lisp_face_equal_p
);
6265 defsubr (&Sinternal_lisp_face_empty_p
);
6266 defsubr (&Sinternal_copy_lisp_face
);
6267 defsubr (&Sinternal_merge_in_global_face
);
6268 defsubr (&Sface_font
);
6269 defsubr (&Sframe_face_alist
);
6270 defsubr (&Sinternal_set_font_selection_order
);
6271 defsubr (&Sinternal_set_alternative_font_family_alist
);
6273 defsubr (&Sdump_face
);
6274 defsubr (&Sshow_face_resources
);
6275 #endif /* GLYPH_DEBUG */
6276 defsubr (&Sclear_face_cache
);
6278 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6279 "*Limit for font matching.\n\
6280 If an integer > 0, font matching functions won't load more than\n\
6281 that number of fonts when searching for a matching font.");
6282 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6284 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6285 "List of global face definitions (for internal use only.)");
6286 Vface_new_frame_defaults
= Qnil
;
6288 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6289 "*Default stipple pattern used on monochrome displays.\n\
6290 This stipple pattern is used on monochrome displays\n\
6291 instead of shades of gray for a face background color.\n\
6292 See `set-face-stipple' for possible values for this variable.");
6293 Vface_default_stipple
= build_string ("gray3");
6295 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6296 "Default registry and encoding to use.\n\
6297 This registry and encoding is used for unibyte text. It is set up\n\
6298 from the specified frame font when Emacs starts. (For internal use only.)");
6299 Vface_default_registry
= Qnil
;
6301 DEFVAR_LISP ("face-alternative-font-family-alist",
6302 &Vface_alternative_font_family_alist
, "");
6303 Vface_alternative_font_family_alist
= Qnil
;
6307 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6308 "Allowed scalable fonts.\n\
6309 A value of nil means don't allow any scalable fonts.\n\
6310 A value of t means allow any scalable font.\n\
6311 Otherwise, value must be a list of regular expressions. A font may be\n\
6312 scaled if its name matches a regular expression in the list.");
6313 Vscalable_fonts_allowed
= Qnil
;
6315 #endif /* SCALABLE_FONTS */
6317 #ifdef HAVE_X_WINDOWS
6318 defsubr (&Spixmap_spec_p
);
6319 defsubr (&Sx_list_fonts
);
6320 defsubr (&Sinternal_face_x_get_resource
);
6321 defsubr (&Sx_font_list
);
6322 defsubr (&Sx_font_family_list
);
6323 #endif /* HAVE_X_WINDOWS */
6325 /* TTY face support. */
6326 defsubr (&Sface_register_tty_color
);
6327 defsubr (&Sface_clear_tty_colors
);
6328 defsubr (&Stty_defined_colors
);
6329 Vface_tty_color_alist
= Qnil
;
6330 staticpro (&Vface_tty_color_alist
);