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 /* The symbols `foreground-color' and `background-color' which can be
315 used as part of a `face' property. This is for compatibility with
318 Lisp_Object Qforeground_color
, Qbackground_color
;
320 /* The symbols `face' and `mouse-face' used as text properties. */
323 extern Lisp_Object Qmouse_face
;
325 /* Error symbol for wrong_type_argument in load_pixmap. */
327 Lisp_Object Qpixmap_spec_p
;
329 /* Alist of global face definitions. Each element is of the form
330 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
331 is a Lisp vector of face attributes. These faces are used
332 to initialize faces for new frames. */
334 Lisp_Object Vface_new_frame_defaults
;
336 /* The next ID to assign to Lisp faces. */
338 static int next_lface_id
;
340 /* A vector mapping Lisp face Id's to face names. */
342 static Lisp_Object
*lface_id_to_name
;
343 static int lface_id_to_name_size
;
345 /* An alist of elements (COLOR-NAME . INDEX) mapping color names
346 to color indices for tty frames. */
348 Lisp_Object Vface_tty_color_alist
;
350 /* Counter for calls to clear_face_cache. If this counter reaches
351 CLEAR_FONT_TABLE_COUNT, and a frame has more than
352 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
354 static int clear_font_table_count
;
355 #define CLEAR_FONT_TABLE_COUNT 100
356 #define CLEAR_FONT_TABLE_NFONTS 10
358 /* Non-zero means face attributes have been changed since the last
359 redisplay. Used in redisplay_internal. */
361 int face_change_count
;
363 /* The total number of colors currently allocated. */
366 static int ncolors_allocated
;
367 static int npixmaps_allocated
;
373 /* Function prototypes. */
378 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
379 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
380 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
382 static int first_font_matching
P_ ((struct frame
*f
, char *,
383 struct font_name
*));
384 static int x_face_list_fonts
P_ ((struct frame
*, char *,
385 struct font_name
*, int, int, int));
386 static int font_scalable_p
P_ ((struct font_name
*));
387 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
388 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
389 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
390 static char *xstrdup
P_ ((char *));
391 static unsigned char *xstrlwr
P_ ((unsigned char *));
392 static void signal_error
P_ ((char *, Lisp_Object
));
393 static void display_message
P_ ((struct frame
*, char *, Lisp_Object
, Lisp_Object
));
394 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
395 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
396 static unsigned long load_color
P_ ((struct frame
*,
399 enum lface_attribute_index
));
400 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
401 static void free_face_colors
P_ ((struct frame
*, struct face
*));
402 static int face_color_gray_p
P_ ((struct frame
*, char *));
403 static char *build_font_name
P_ ((struct font_name
*));
404 static void free_font_names
P_ ((struct font_name
*, int));
405 static int sorted_font_list
P_ ((struct frame
*, char *,
406 int (*cmpfn
) P_ ((const void *, const void *)),
407 struct font_name
**));
408 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
409 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
410 struct font_name
**));
411 static int cmp_font_names
P_ ((const void *, const void *));
412 static struct face
*realize_face
P_ ((struct face_cache
*,
413 Lisp_Object
*, int));
414 static struct face
*realize_x_face
P_ ((struct face_cache
*,
415 Lisp_Object
*, int));
416 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
417 Lisp_Object
*, int));
418 static int realize_basic_faces
P_ ((struct frame
*));
419 static int realize_default_face
P_ ((struct frame
*));
420 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
421 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
422 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
423 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
424 static unsigned lface_hash
P_ ((Lisp_Object
*));
425 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
426 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
427 static void free_realized_face
P_ ((struct frame
*, struct face
*));
428 static void clear_face_gcs
P_ ((struct face_cache
*));
429 static void free_face_cache
P_ ((struct face_cache
*));
430 static int face_numeric_weight
P_ ((Lisp_Object
));
431 static int face_numeric_slant
P_ ((Lisp_Object
));
432 static int face_numeric_swidth
P_ ((Lisp_Object
));
433 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
434 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
436 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
438 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
439 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
441 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
443 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
444 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
445 static void free_realized_faces
P_ ((struct face_cache
*));
446 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
447 struct font_name
*, int));
448 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
449 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
450 static int xlfd_numeric_slant
P_ ((struct font_name
*));
451 static int xlfd_numeric_weight
P_ ((struct font_name
*));
452 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
453 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
454 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
455 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
456 static int xlfd_fixed_p
P_ ((struct font_name
*));
457 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
459 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
460 struct font_name
*, int, int));
461 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
462 struct font_name
*, int));
464 #ifdef HAVE_X_WINDOWS
466 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
467 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
468 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
469 int (*cmpfn
) P_ ((const void *, const void *))));
470 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
471 static void x_free_gc
P_ ((struct frame
*, GC
));
472 static void clear_font_table
P_ ((struct frame
*));
474 #endif /* HAVE_X_WINDOWS */
477 /***********************************************************************
479 ***********************************************************************/
481 #ifdef HAVE_X_WINDOWS
483 /* Create and return a GC for use on frame F. GC values and mask
484 are given by XGCV and MASK. */
487 x_create_gc (f
, mask
, xgcv
)
494 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
501 /* Free GC which was used on frame F. */
509 xassert (--ngcs
>= 0);
510 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
514 #endif /* HAVE_X_WINDOWS */
517 /* Like strdup, but uses xmalloc. */
523 int len
= strlen (s
) + 1;
524 char *p
= (char *) xmalloc (len
);
530 /* Like stricmp. Used to compare parts of font names which are in
535 unsigned char *s1
, *s2
;
539 unsigned char c1
= tolower (*s1
);
540 unsigned char c2
= tolower (*s2
);
542 return c1
< c2
? -1 : 1;
547 return *s2
== 0 ? 0 : -1;
552 /* Like strlwr, which might not always be available. */
554 static unsigned char *
558 unsigned char *p
= s
;
567 /* Signal `error' with message S, and additional argument ARG. */
570 signal_error (s
, arg
)
574 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
578 /* Display a message with format string FORMAT and arguments ARG1 and
579 ARG2 on frame F. Used to display errors if fonts, bitmaps, colors
580 etc. for a realized face on frame F cannot be loaded. (If we would
581 signal an error in these cases, we would end up in an infinite
582 recursion because this would stop realization, and the redisplay
583 triggered by the signal would try to realize that same face again.)
585 If basic faces of F are not realized, just add the message to the
586 messages buffer "*Messages*". Because Fmessage calls
587 echo_area_display which tries to realize basic faces again, we would
588 otherwise also end in an infinite recursion. */
591 display_message (f
, format
, arg1
, arg2
)
594 Lisp_Object arg1
, arg2
;
598 extern int waiting_for_input
;
600 /* Function note_mouse_highlight calls face_at_buffer_position which
601 may realize a face. If some attribute of that face is invalid,
602 say an invalid color, don't display an error to avoid calling
603 Lisp from XTread_socket. */
604 if (waiting_for_input
)
607 nargs
= make_number (DIM (args
));
608 args
[0] = build_string (format
);
612 if (f
->face_cache
->used
>= BASIC_FACE_ID_SENTINEL
)
613 Fmessage (nargs
, args
);
616 Lisp_Object msg
= Fformat (nargs
, args
);
617 char *buffer
= LSTRDUPA (msg
);
618 message_dolog (buffer
, strlen (buffer
), 1, 0);
623 /* If FRAME is nil, return selected_frame. Otherwise, check that
624 FRAME is a live frame, and return a pointer to it. NPARAM
625 is the parameter number of FRAME, for CHECK_LIVE_FRAME. This is
626 here because it's a frequent pattern in Lisp function definitions. */
628 static INLINE
struct frame
*
629 frame_or_selected_frame (frame
, nparam
)
639 CHECK_LIVE_FRAME (frame
, nparam
);
647 /***********************************************************************
649 ***********************************************************************/
651 /* Initialize face cache and basic faces for frame F. */
657 /* Make a face cache, if F doesn't have one. */
658 if (FRAME_FACE_CACHE (f
) == NULL
)
659 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
661 #ifdef HAVE_X_WINDOWS
662 /* Make the image cache. */
665 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
666 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
667 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
669 #endif /* HAVE_X_WINDOWS */
671 /* Realize basic faces. Must have enough information in frame
672 parameters to realize basic faces at this point. */
673 #ifdef HAVE_X_WINDOWS
674 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
676 if (!realize_basic_faces (f
))
681 /* Free face cache of frame F. Called from Fdelete_frame. */
687 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
691 free_face_cache (face_cache
);
692 FRAME_FACE_CACHE (f
) = NULL
;
695 #ifdef HAVE_X_WINDOWS
698 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
701 --image_cache
->refcount
;
702 if (image_cache
->refcount
== 0)
703 free_image_cache (f
);
706 #endif /* HAVE_X_WINDOWS */
710 /* Recompute basic faces for frame F. Call this after changing frame
711 parameters on which those faces depend, or when realized faces have
712 been freed due to changing attributes of named faces. */
715 recompute_basic_faces (f
)
718 if (FRAME_FACE_CACHE (f
))
720 int realized_p
= realize_basic_faces (f
);
721 xassert (realized_p
);
726 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
727 try to free unused fonts, too. */
730 clear_face_cache (clear_fonts_p
)
733 #ifdef HAVE_X_WINDOWS
734 Lisp_Object tail
, frame
;
738 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
740 /* From time to time see if we can unload some fonts. This also
741 frees all realized faces on all frames. Fonts needed by
742 faces will be loaded again when faces are realized again. */
743 clear_font_table_count
= 0;
745 FOR_EACH_FRAME (tail
, frame
)
749 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
751 free_all_realized_faces (frame
);
752 clear_font_table (f
);
758 /* Clear GCs of realized faces. */
759 FOR_EACH_FRAME (tail
, frame
)
764 clear_face_gcs (FRAME_FACE_CACHE (f
));
765 clear_image_cache (f
, 0);
769 #endif /* HAVE_X_WINDOWS */
773 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
774 "Clear face caches on all frames.\n\
775 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
777 Lisp_Object thorougly
;
779 clear_face_cache (!NILP (thorougly
));
785 #ifdef HAVE_X_WINDOWS
788 /* Remove those fonts from the font table of frame F that are not used
789 by fontsets. Called from clear_face_cache from time to time. */
795 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
797 Lisp_Object rest
, frame
;
800 xassert (FRAME_X_P (f
));
802 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
803 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
805 /* For all frames with the same x_display_info as F, record
806 in `used' those fonts that are in use by fontsets. */
807 FOR_EACH_FRAME (rest
, frame
)
808 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
810 struct frame
*f
= XFRAME (frame
);
811 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
813 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
815 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
818 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
820 int idx
= info
->font_indexes
[j
];
827 /* Free those fonts that are not used by fontsets. */
828 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
829 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
831 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
833 /* Free names. In xfns.c there is a comment that full_name
834 should never be freed because it is always shared with
835 something else. I don't think this is true anymore---see
836 x_load_font. It's either equal to font_info->name or
837 allocated via xmalloc, and there seems to be no place in
838 the source files where full_name is transferred to another
840 if (font_info
->full_name
!= font_info
->name
)
841 xfree (font_info
->full_name
);
842 xfree (font_info
->name
);
846 XFreeFont (dpyinfo
->display
, font_info
->font
);
849 /* Mark font table slot free. */
850 font_info
->font
= NULL
;
851 font_info
->name
= font_info
->full_name
= NULL
;
856 #endif /* HAVE_X_WINDOWS */
860 /***********************************************************************
862 ***********************************************************************/
864 #ifdef HAVE_X_WINDOWS
866 DEFUN ("pixmap-spec-p", Fpixmap_spec_p
, Spixmap_spec_p
, 1, 1, 0,
867 "Non-nil if OBJECT is a valid pixmap specification.\n\
868 A pixmap specification is either a string, or a list (WIDTH HEIGHT DATA)\n\
869 where WIDTH is the pixel width of the pixmap, HEIGHT is its height,\n\
870 and DATA contains the bits of the pixmap.")
874 Lisp_Object height
, width
;
876 return ((STRINGP (object
)
878 && CONSP (XCONS (object
)->cdr
)
879 && CONSP (XCONS (XCONS (object
)->cdr
)->cdr
)
880 && NILP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->cdr
)
881 && (width
= XCONS (object
)->car
, INTEGERP (width
))
882 && (height
= XCONS (XCONS (object
)->cdr
)->car
,
884 && STRINGP (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)
887 /* The string must have enough bits for width * height. */
888 && ((XSTRING (XCONS (XCONS (XCONS (object
)->cdr
)->cdr
)->car
)->size
889 * (BITS_PER_INT
/ sizeof (int)))
890 >= XFASTINT (width
) * XFASTINT (height
))))
895 /* Load a bitmap according to NAME (which is either a file name or a
896 pixmap spec) for use on frame F. Value is the bitmap_id (see
897 xfns.c). If NAME is nil, return with a bitmap id of zero. If
898 bitmap cannot be loaded, display a message saying so, and return
899 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
900 if these pointers are not null. */
903 load_pixmap (f
, name
, w_ptr
, h_ptr
)
906 unsigned int *w_ptr
, *h_ptr
;
914 tem
= Fpixmap_spec_p (name
);
916 wrong_type_argument (Qpixmap_spec_p
, name
);
921 /* Decode a bitmap spec into a bitmap. */
926 w
= XINT (Fcar (name
));
927 h
= XINT (Fcar (Fcdr (name
)));
928 bits
= Fcar (Fcdr (Fcdr (name
)));
930 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
935 /* It must be a string -- a file name. */
936 bitmap_id
= x_create_bitmap_from_file (f
, name
);
942 display_message (f
, "Invalid or undefined bitmap %s", name
, Qnil
);
953 ++npixmaps_allocated
;
956 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
959 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
965 #endif /* HAVE_X_WINDOWS */
969 /***********************************************************************
971 ***********************************************************************/
973 #ifdef HAVE_X_WINDOWS
975 /* Update the line_height of frame F. Return non-zero if line height
979 frame_update_line_height (f
)
982 int fontset
, line_height
, changed_p
;
984 fontset
= f
->output_data
.x
->fontset
;
986 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
988 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
990 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
991 f
->output_data
.x
->line_height
= line_height
;
995 #endif /* HAVE_X_WINDOWS */
998 /***********************************************************************
1000 ***********************************************************************/
1002 #ifdef HAVE_X_WINDOWS
1004 /* Load font or fontset of face FACE which is used on frame F.
1005 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1006 fontset. FONT_NAME is the name of the font to load, if no fontset
1007 is used. It is null if no suitable font name could be determined
1011 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1017 struct font_info
*font_info
= NULL
;
1019 face
->font_info_id
= -1;
1020 face
->fontset
= fontset
;
1025 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1028 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1037 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1038 face
->font
= font_info
->font
;
1039 face
->font_name
= font_info
->full_name
;
1041 /* Make the registry part of the font name readily accessible.
1042 The registry is used to find suitable faces for unibyte text. */
1043 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1045 while (i
< 2 && --s
>= font_info
->full_name
)
1049 if (!STRINGP (face
->registry
)
1050 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1052 if (STRINGP (Vface_default_registry
)
1053 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1054 face
->registry
= Vface_default_registry
;
1056 face
->registry
= build_string (s
+ 1);
1059 else if (fontset
>= 0)
1060 display_message (f
, "Unable to load ASCII font of fontset %d",
1061 make_number (fontset
), Qnil
);
1063 display_message (f
, "Unable to load font %s",
1064 build_string (font_name
), Qnil
);
1067 #endif /* HAVE_X_WINDOWS */
1071 /***********************************************************************
1073 ***********************************************************************/
1075 #ifdef HAVE_X_WINDOWS
1077 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1078 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1081 face_color_gray_p (f
, color_name
)
1088 if (defined_color (f
, color_name
, &color
, 0))
1089 gray_p
= ((abs (color
.red
- color
.green
)
1090 < max (color
.red
, color
.green
) / 20)
1091 && (abs (color
.green
- color
.blue
)
1092 < max (color
.green
, color
.blue
) / 20)
1093 && (abs (color
.blue
- color
.red
)
1094 < max (color
.blue
, color
.red
) / 20));
1102 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1103 BACKGROUND_P non-zero means the color will be used as background
1107 face_color_supported_p (f
, color_name
, background_p
)
1114 XSETFRAME (frame
, f
);
1115 return (!NILP (Vwindow_system
)
1116 && (!NILP (Fx_display_color_p (frame
))
1117 || xstricmp (color_name
, "black") == 0
1118 || xstricmp (color_name
, "white") == 0
1120 && face_color_gray_p (f
, color_name
))
1121 || (!NILP (Fx_display_grayscale_p (frame
))
1122 && face_color_gray_p (f
, color_name
))));
1126 DEFUN ("face-color-gray-p", Fface_color_gray_p
, Sface_color_gray_p
, 1, 2, 0,
1127 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1128 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1129 If FRAME is nil or omitted, use the selected frame.")
1131 Lisp_Object color
, frame
;
1133 struct frame
*f
= check_x_frame (frame
);
1134 CHECK_STRING (color
, 0);
1135 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1139 DEFUN ("face-color-supported-p", Fface_color_supported_p
,
1140 Sface_color_supported_p
, 2, 3, 0,
1141 "Return non-nil if COLOR can be displayed on FRAME.\n\
1142 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1143 If FRAME is nil or omitted, use the selected frame.\n\
1144 COLOR must be a valid color name.")
1145 (frame
, color
, background_p
)
1146 Lisp_Object frame
, color
, background_p
;
1148 struct frame
*f
= check_x_frame (frame
);
1149 CHECK_STRING (color
, 0);
1150 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1155 /* Load color with name NAME for use by face FACE on frame F.
1156 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1157 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1158 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1159 pixel color. If color cannot be loaded, display a message, and
1160 return the foreground, background or underline color of F, but
1161 record that fact in flags of the face so that we don't try to free
1164 static unsigned long
1165 load_color (f
, face
, name
, target_index
)
1169 enum lface_attribute_index target_index
;
1173 xassert (STRINGP (name
));
1174 xassert (target_index
== LFACE_FOREGROUND_INDEX
1175 || target_index
== LFACE_BACKGROUND_INDEX
1176 || target_index
== LFACE_UNDERLINE_INDEX
1177 || target_index
== LFACE_OVERLINE_INDEX
1178 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1179 || target_index
== LFACE_BOX_INDEX
);
1181 /* if the color map is full, defined_color will return a best match
1182 to the values in an existing cell. */
1183 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1185 display_message (f
, "Unable to load color %s", name
, Qnil
);
1187 switch (target_index
)
1189 case LFACE_FOREGROUND_INDEX
:
1190 face
->foreground_defaulted_p
= 1;
1191 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1194 case LFACE_BACKGROUND_INDEX
:
1195 face
->background_defaulted_p
= 1;
1196 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1199 case LFACE_UNDERLINE_INDEX
:
1200 face
->underline_defaulted_p
= 1;
1201 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1204 case LFACE_OVERLINE_INDEX
:
1205 face
->overline_color_defaulted_p
= 1;
1206 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1209 case LFACE_STRIKE_THROUGH_INDEX
:
1210 face
->strike_through_color_defaulted_p
= 1;
1211 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1214 case LFACE_BOX_INDEX
:
1215 face
->box_color_defaulted_p
= 1;
1216 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1225 ++ncolors_allocated
;
1232 /* Load colors for face FACE which is used on frame F. Colors are
1233 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1234 of ATTRS. If the background color specified is not supported on F,
1235 try to emulate gray colors with a stipple from Vface_default_stipple. */
1238 load_face_colors (f
, face
, attrs
)
1245 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1246 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1248 /* Swap colors if face is inverse-video. */
1249 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1257 /* Check for support for foreground, not for background because
1258 face_color_supported_p is smart enough to know that grays are
1259 "supported" as background because we are supposed to use stipple
1261 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1262 && !NILP (Fpixmap_spec_p (Vface_default_stipple
)))
1264 x_destroy_bitmap (f
, face
->stipple
);
1265 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1266 &face
->pixmap_w
, &face
->pixmap_h
);
1269 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1270 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1274 /* Free color PIXEL on frame F. */
1277 unload_color (f
, pixel
)
1279 unsigned long pixel
;
1281 Display
*dpy
= FRAME_X_DISPLAY (f
);
1282 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1284 if (pixel
== BLACK_PIX_DEFAULT (f
)
1285 || pixel
== WHITE_PIX_DEFAULT (f
))
1290 /* If display has an immutable color map, freeing colors is not
1291 necessary and some servers don't allow it. So don't do it. */
1292 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1294 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1295 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1302 /* Free colors allocated for FACE. */
1305 free_face_colors (f
, face
)
1309 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1311 /* If display has an immutable color map, freeing colors is not
1312 necessary and some servers don't allow it. So don't do it. */
1313 if (class != StaticColor
1314 && class != StaticGray
1315 && class != TrueColor
)
1321 dpy
= FRAME_X_DISPLAY (f
);
1322 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1324 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1325 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1326 && !face
->foreground_defaulted_p
)
1328 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1329 IF_DEBUG (--ncolors_allocated
);
1332 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1333 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1334 && !face
->background_defaulted_p
)
1336 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1337 IF_DEBUG (--ncolors_allocated
);
1340 if (face
->underline_p
1341 && !face
->underline_defaulted_p
1342 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1343 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1345 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1346 IF_DEBUG (--ncolors_allocated
);
1349 if (face
->overline_p
1350 && !face
->overline_color_defaulted_p
1351 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1352 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1354 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1355 IF_DEBUG (--ncolors_allocated
);
1358 if (face
->strike_through_p
1359 && !face
->strike_through_color_defaulted_p
1360 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1361 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1363 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1364 IF_DEBUG (--ncolors_allocated
);
1367 if (face
->box
!= FACE_NO_BOX
1368 && !face
->box_color_defaulted_p
1369 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1370 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1372 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1373 IF_DEBUG (--ncolors_allocated
);
1380 #endif /* HAVE_X_WINDOWS */
1384 /***********************************************************************
1386 ***********************************************************************/
1388 /* An enumerator for each field of an XLFD font name. */
1409 /* An enumerator for each possible slant value of a font. Taken from
1410 the XLFD specification. */
1418 XLFD_SLANT_REVERSE_ITALIC
,
1419 XLFD_SLANT_REVERSE_OBLIQUE
,
1423 /* Relative font weight according to XLFD documentation. */
1427 XLFD_WEIGHT_UNKNOWN
,
1428 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1429 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1430 XLFD_WEIGHT_LIGHT
, /* 30 */
1431 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1432 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1433 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1434 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1435 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1436 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1439 /* Relative proportionate width. */
1443 XLFD_SWIDTH_UNKNOWN
,
1444 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1445 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1446 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1447 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1448 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1449 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1450 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1451 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1452 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1455 /* Structure used for tables mapping XLFD weight, slant, and width
1456 names to numeric and symbolic values. */
1462 Lisp_Object
*symbol
;
1465 /* Table of XLFD slant names and their numeric and symbolic
1466 representations. This table must be sorted by slant names in
1469 static struct table_entry slant_table
[] =
1471 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1472 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1473 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1474 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1475 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1476 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1479 /* Table of XLFD weight names. This table must be sorted by weight
1480 names in ascending order. */
1482 static struct table_entry weight_table
[] =
1484 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1485 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1486 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1487 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1488 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1489 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1490 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1491 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1492 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1493 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1494 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1495 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1496 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1497 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1498 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1501 /* Table of XLFD width names. This table must be sorted by width
1502 names in ascending order. */
1504 static struct table_entry swidth_table
[] =
1506 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1507 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1508 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1509 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1510 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1511 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1512 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1513 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1514 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1515 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1516 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1517 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1518 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1519 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1520 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1523 /* Structure used to hold the result of splitting font names in XLFD
1524 format into their fields. */
1528 /* The original name which is modified destructively by
1529 split_font_name. The pointer is kept here to be able to free it
1530 if it was allocated from the heap. */
1533 /* Font name fields. Each vector element points into `name' above.
1534 Fields are NUL-terminated. */
1535 char *fields
[XLFD_LAST
];
1537 /* Numeric values for those fields that interest us. See
1538 split_font_name for which these are. */
1539 int numeric
[XLFD_LAST
];
1542 /* The frame in effect when sorting font names. Set temporarily in
1543 sort_fonts so that it is available in font comparison functions. */
1545 static struct frame
*font_frame
;
1547 /* Order by which font selection chooses fonts. The default values
1548 mean `first, find a best match for the font width, then for the
1549 font height, then for weight, then for slant.' This variable can be
1550 set via set-face-font-sort-order. */
1552 static int font_sort_order
[4];
1555 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1556 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1557 is a pointer to the matching table entry or null if no table entry
1560 static struct table_entry
*
1561 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1562 struct table_entry
*table
;
1564 struct font_name
*font
;
1567 /* Function split_font_name converts fields to lower-case, so there
1568 is no need to use xstrlwr or xstricmp here. */
1569 char *s
= font
->fields
[field_index
];
1570 int low
, mid
, high
, cmp
;
1577 mid
= (low
+ high
) / 2;
1578 cmp
= strcmp (table
[mid
].name
, s
);
1592 /* Return a numeric representation for font name field
1593 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1594 has DIM entries. Value is the numeric value found or DFLT if no
1595 table entry matches. This function is used to translate weight,
1596 slant, and swidth names of XLFD font names to numeric values. */
1599 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1600 struct table_entry
*table
;
1602 struct font_name
*font
;
1606 struct table_entry
*p
;
1607 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1608 return p
? p
->numeric
: dflt
;
1612 /* Return a symbolic representation for font name field
1613 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1614 has DIM entries. Value is the symbolic value found or DFLT if no
1615 table entry matches. This function is used to translate weight,
1616 slant, and swidth names of XLFD font names to symbols. */
1618 static INLINE Lisp_Object
1619 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1620 struct table_entry
*table
;
1622 struct font_name
*font
;
1626 struct table_entry
*p
;
1627 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1628 return p
? *p
->symbol
: dflt
;
1632 /* Return a numeric value for the slant of the font given by FONT. */
1635 xlfd_numeric_slant (font
)
1636 struct font_name
*font
;
1638 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1639 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1643 /* Return a symbol representing the weight of the font given by FONT. */
1645 static INLINE Lisp_Object
1646 xlfd_symbolic_slant (font
)
1647 struct font_name
*font
;
1649 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1650 font
, XLFD_SLANT
, Qnormal
);
1654 /* Return a numeric value for the weight of the font given by FONT. */
1657 xlfd_numeric_weight (font
)
1658 struct font_name
*font
;
1660 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1661 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1665 /* Return a symbol representing the slant of the font given by FONT. */
1667 static INLINE Lisp_Object
1668 xlfd_symbolic_weight (font
)
1669 struct font_name
*font
;
1671 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1672 font
, XLFD_WEIGHT
, Qnormal
);
1676 /* Return a numeric value for the swidth of the font whose XLFD font
1677 name fields are found in FONT. */
1680 xlfd_numeric_swidth (font
)
1681 struct font_name
*font
;
1683 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1684 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1688 /* Return a symbolic value for the swidth of FONT. */
1690 static INLINE Lisp_Object
1691 xlfd_symbolic_swidth (font
)
1692 struct font_name
*font
;
1694 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1695 font
, XLFD_SWIDTH
, Qnormal
);
1699 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1700 entries. Value is a pointer to the matching table entry or null if
1701 no element of TABLE contains SYMBOL. */
1703 static struct table_entry
*
1704 face_value (table
, dim
, symbol
)
1705 struct table_entry
*table
;
1711 xassert (SYMBOLP (symbol
));
1713 for (i
= 0; i
< dim
; ++i
)
1714 if (EQ (*table
[i
].symbol
, symbol
))
1717 return i
< dim
? table
+ i
: NULL
;
1721 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1722 entries. Value is -1 if SYMBOL is not found in TABLE. */
1725 face_numeric_value (table
, dim
, symbol
)
1726 struct table_entry
*table
;
1730 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1731 return p
? p
->numeric
: -1;
1735 /* Return a numeric value representing the weight specified by Lisp
1736 symbol WEIGHT. Value is one of the enumerators of enum
1740 face_numeric_weight (weight
)
1743 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1747 /* Return a numeric value representing the slant specified by Lisp
1748 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1751 face_numeric_slant (slant
)
1754 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1758 /* Return a numeric value representing the swidth specified by Lisp
1759 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1762 face_numeric_swidth (width
)
1765 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1769 #ifdef HAVE_X_WINDOWS
1771 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1775 struct font_name
*font
;
1777 /* Function split_font_name converts fields to lower-case, so there
1778 is no need to use tolower here. */
1779 return *font
->fields
[XLFD_SPACING
] != 'p';
1783 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1785 The actual height of the font when displayed on F depends on the
1786 resolution of both the font and frame. For example, a 10pt font
1787 designed for a 100dpi display will display larger than 10pt on a
1788 75dpi display. (It's not unusual to use fonts not designed for the
1789 display one is using. For example, some intlfonts are available in
1790 72dpi versions, only.)
1792 Value is the real point size of FONT on frame F, or 0 if it cannot
1796 xlfd_point_size (f
, font
)
1798 struct font_name
*font
;
1800 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1801 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1802 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1805 if (font_resy
== 0 || font_pt
== 0)
1808 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1814 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1815 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1816 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1817 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1818 zero if the font name doesn't have the format we expect. The
1819 expected format is a font name that starts with a `-' and has
1820 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1821 forms of font names where certain field contents are enclosed in
1822 square brackets. We don't support that, for now. */
1825 split_font_name (f
, font
, numeric_p
)
1827 struct font_name
*font
;
1833 if (*font
->name
== '-')
1835 char *p
= xstrlwr (font
->name
) + 1;
1837 while (i
< XLFD_LAST
)
1839 font
->fields
[i
] = p
;
1842 while (*p
&& *p
!= '-')
1852 success_p
= i
== XLFD_LAST
;
1854 /* If requested, and font name was in the expected format,
1855 compute numeric values for some fields. */
1856 if (numeric_p
&& success_p
)
1858 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1859 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1860 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1861 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1862 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
1869 /* Build an XLFD font name from font name fields in FONT. Value is a
1870 pointer to the font name, which is allocated via xmalloc. */
1873 build_font_name (font
)
1874 struct font_name
*font
;
1878 char *font_name
= (char *) xmalloc (size
);
1879 int total_length
= 0;
1881 for (i
= 0; i
< XLFD_LAST
; ++i
)
1883 /* Add 1 because of the leading `-'. */
1884 int len
= strlen (font
->fields
[i
]) + 1;
1886 /* Reallocate font_name if necessary. Add 1 for the final
1888 if (total_length
+ len
+ 1 >= size
)
1890 int new_size
= max (2 * size
, size
+ len
+ 1);
1891 int sz
= new_size
* sizeof *font_name
;
1892 font_name
= (char *) xrealloc (font_name
, sz
);
1896 font_name
[total_length
] = '-';
1897 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
1898 total_length
+= len
;
1901 font_name
[total_length
] = 0;
1906 /* Free an array FONTS of N font_name structures. This frees FONTS
1907 itself and all `name' fields in its elements. */
1910 free_font_names (fonts
, n
)
1911 struct font_name
*fonts
;
1915 xfree (fonts
[--n
].name
);
1920 /* Sort vector FONTS of font_name structures which contains NFONTS
1921 elements using qsort and comparison function CMPFN. F is the frame
1922 on which the fonts will be used. The global variable font_frame
1923 is temporarily set to F to make it available in CMPFN. */
1926 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
1928 struct font_name
*fonts
;
1930 int (*cmpfn
) P_ ((const void *, const void *));
1933 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
1938 /* Get fonts matching PATTERN on frame F. If F is null, use the first
1939 display in x_display_list. FONTS is a pointer to a vector of
1940 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
1941 alternative patterns from Valternate_fontname_alist if no fonts are
1942 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
1945 For all fonts found, set FONTS[i].name to the name of the font,
1946 allocated via xmalloc, and split font names into fields. Ignore
1947 fonts that we can't parse. Value is the number of fonts found.
1949 This is similar to x_list_fonts. The differences are:
1951 1. It avoids consing.
1952 2. It never calls XLoadQueryFont. */
1955 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
1959 struct font_name
*fonts
;
1960 int nfonts
, try_alternatives_p
;
1961 int scalable_fonts_p
;
1963 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
1967 /* Get the list of fonts matching PATTERN from the X server. */
1969 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
1974 /* Make a copy of the font names we got from X, and
1975 split them into fields. */
1976 for (i
= j
= 0; i
< n
; ++i
)
1978 /* Make a copy of the font name. */
1979 fonts
[j
].name
= xstrdup (names
[i
]);
1981 /* Ignore fonts having a name that we can't parse. */
1982 if (!split_font_name (f
, fonts
+ j
, 1))
1983 xfree (fonts
[j
].name
);
1984 else if (font_scalable_p (fonts
+ j
))
1987 if (!scalable_fonts_p
1988 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
1989 xfree (fonts
[j
].name
);
1992 #else /* !SCALABLE_FONTS */
1993 /* Always ignore scalable fonts. */
1994 xfree (fonts
[j
].name
);
1995 #endif /* !SCALABLE_FONTS */
2003 /* Free font names. */
2005 XFreeFontNames (names
);
2010 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2011 if (n
== 0 && try_alternatives_p
)
2013 Lisp_Object list
= Valternate_fontname_alist
;
2015 while (CONSP (list
))
2017 Lisp_Object entry
= XCAR (list
);
2019 && STRINGP (XCAR (entry
))
2020 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2027 Lisp_Object patterns
= XCAR (list
);
2030 while (CONSP (patterns
)
2031 /* If list is screwed up, give up. */
2032 && (name
= XCAR (patterns
),
2034 /* Ignore patterns equal to PATTERN because we tried that
2035 already with no success. */
2036 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2037 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2041 patterns
= XCDR (patterns
);
2049 /* Determine the first font matching PATTERN on frame F. Return in
2050 *FONT the matching font name, split into fields. Value is non-zero
2051 if a match was found. */
2054 first_font_matching (f
, pattern
, font
)
2057 struct font_name
*font
;
2060 struct font_name
*fonts
;
2062 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2063 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2067 bcopy (&fonts
[0], font
, sizeof *font
);
2069 fonts
[0].name
= NULL
;
2070 free_font_names (fonts
, nfonts
);
2077 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2078 using comparison function CMPFN. Value is the number of fonts
2079 found. If value is non-zero, *FONTS is set to a vector of
2080 font_name structures allocated from the heap containing matching
2081 fonts. Each element of *FONTS contains a name member that is also
2082 allocated from the heap. Font names in these structures are split
2083 into fields. Use free_font_names to free such an array. */
2086 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2089 int (*cmpfn
) P_ ((const void *, const void *));
2090 struct font_name
**fonts
;
2094 /* Get the list of fonts matching pattern. 100 should suffice. */
2096 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2098 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2100 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2103 /* Sort the resulting array and return it in *FONTS. If no
2104 fonts were found, make sure to set *FONTS to null. */
2106 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2117 /* Compare two font_name structures *A and *B. Value is analogous to
2118 strcmp. Sort order is given by the global variable
2119 font_sort_order. Font names are sorted so that, everything else
2120 being equal, fonts with a resolution closer to that of the frame on
2121 which they are used are listed first. The global variable
2122 font_frame is the frame on which we operate. */
2125 cmp_font_names (a
, b
)
2128 struct font_name
*x
= (struct font_name
*) a
;
2129 struct font_name
*y
= (struct font_name
*) b
;
2132 /* All strings have been converted to lower-case by split_font_name,
2133 so we can use strcmp here. */
2134 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2139 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2141 int j
= font_sort_order
[i
];
2142 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2147 /* Everything else being equal, we prefer fonts with an
2148 y-resolution closer to that of the frame. */
2149 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2150 int x_resy
= x
->numeric
[XLFD_RESY
];
2151 int y_resy
= y
->numeric
[XLFD_RESY
];
2152 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2160 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2161 is non-null list fonts matching that pattern. Otherwise, if
2162 REGISTRY_AND_ENCODING is non-null return only fonts with that
2163 registry and encoding, otherwise return fonts of any registry and
2164 encoding. Set *FONTS to a vector of font_name structures allocated
2165 from the heap containing the fonts found. Value is the number of
2169 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2173 char *registry_and_encoding
;
2174 struct font_name
**fonts
;
2176 if (pattern
== NULL
)
2181 if (registry_and_encoding
== NULL
)
2182 registry_and_encoding
= "*";
2184 pattern
= (char *) alloca (strlen (family
)
2185 + strlen (registry_and_encoding
)
2187 if (index (family
, '-'))
2188 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2190 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2193 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2197 /* Remove elements from LIST whose cars are `equal'. Called from
2198 x-font-list and x-font-family-list to remove duplicate font
2202 remove_duplicates (list
)
2205 Lisp_Object tail
= list
;
2207 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2209 Lisp_Object next
= XCDR (tail
);
2210 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2211 XCDR (tail
) = XCDR (next
);
2218 DEFUN ("x-font-list", Fxfont_list
, Sx_font_list
, 0, 2, 0,
2219 "Return a list of available fonts of family FAMILY on FRAME.\n\
2220 If FAMILY is omitted or nil, list all families.\n\
2221 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2223 If FRAME is omitted or nil, use the selected frame.\n\
2224 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2226 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2227 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2228 width, weight and slant of the font. These symbols are the same as for\n\
2229 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2230 The result list is sorted according to the current setting of\n\
2231 the face font sort order.")
2233 Lisp_Object family
, frame
;
2235 struct frame
*f
= check_x_frame (frame
);
2236 struct font_name
*fonts
;
2239 struct gcpro gcpro1
;
2240 char *family_pattern
;
2243 family_pattern
= "*";
2246 CHECK_STRING (family
, 1);
2247 family_pattern
= LSTRDUPA (family
);
2252 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2253 for (i
= nfonts
- 1; i
>= 0; --i
)
2255 Lisp_Object v
= Fmake_vector (make_number (6), Qnil
);
2257 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2259 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2260 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2261 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2262 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2263 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2264 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2265 result
= Fcons (v
, result
);
2270 remove_duplicates (result
);
2271 free_font_names (fonts
, nfonts
);
2277 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2279 "Return a list of available font families on FRAME.\n\
2280 If FRAME is omitted or nil, use the selected frame.\n\
2281 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2282 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2287 struct frame
*f
= check_x_frame (frame
);
2289 struct font_name
*fonts
;
2291 struct gcpro gcpro1
;
2293 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2296 for (i
= nfonts
- 1; i
>= 0; --i
)
2297 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2298 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2301 remove_duplicates (result
);
2302 free_font_names (fonts
, nfonts
);
2308 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2309 "Return a list of the names of available fonts matching PATTERN.\n\
2310 If optional arguments FACE and FRAME are specified, return only fonts\n\
2311 the same size as FACE on FRAME.\n\
2312 PATTERN is a string, perhaps with wildcard characters;\n\
2313 the * character matches any substring, and\n\
2314 the ? character matches any single character.\n\
2315 PATTERN is case-insensitive.\n\
2316 FACE is a face name--a symbol.\n\
2318 The return value is a list of strings, suitable as arguments to\n\
2321 Fonts Emacs can't use may or may not be excluded\n\
2322 even if they match PATTERN and FACE.\n\
2323 The optional fourth argument MAXIMUM sets a limit on how many\n\
2324 fonts to match. The first MAXIMUM fonts are reported.\n\
2325 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2326 occupied by a character of a font. In that case, return only fonts\n\
2327 the WIDTH times as wide as FACE on FRAME.")
2328 (pattern
, face
, frame
, maximum
, width
)
2329 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2336 CHECK_STRING (pattern
, 0);
2342 CHECK_NATNUM (maximum
, 0);
2343 maxnames
= XINT (maximum
);
2347 CHECK_NUMBER (width
, 4);
2349 /* We can't simply call check_x_frame because this function may be
2350 called before any frame is created. */
2351 f
= frame_or_selected_frame (frame
, 2);
2354 /* Perhaps we have not yet created any frame. */
2359 /* Determine the width standard for comparison with the fonts we find. */
2365 /* This is of limited utility since it works with character
2366 widths. Keep it for compatibility. --gerd. */
2367 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2368 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2371 size
= face
->font
->max_bounds
.width
;
2373 size
= FRAME_FONT (f
)->max_bounds
.width
;
2376 size
*= XINT (width
);
2380 Lisp_Object args
[2];
2382 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2384 /* We don't have to check fontsets. */
2386 args
[1] = list_fontsets (f
, pattern
, size
);
2387 return Fnconc (2, args
);
2391 #endif /* HAVE_X_WINDOWS */
2395 /***********************************************************************
2397 ***********************************************************************/
2399 /* Access face attributes of face FACE, a Lisp vector. */
2401 #define LFACE_FAMILY(LFACE) \
2402 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2403 #define LFACE_HEIGHT(LFACE) \
2404 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2405 #define LFACE_WEIGHT(LFACE) \
2406 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2407 #define LFACE_SLANT(LFACE) \
2408 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2409 #define LFACE_UNDERLINE(LFACE) \
2410 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2411 #define LFACE_INVERSE(LFACE) \
2412 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2413 #define LFACE_FOREGROUND(LFACE) \
2414 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2415 #define LFACE_BACKGROUND(LFACE) \
2416 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2417 #define LFACE_STIPPLE(LFACE) \
2418 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2419 #define LFACE_SWIDTH(LFACE) \
2420 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2421 #define LFACE_OVERLINE(LFACE) \
2422 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2423 #define LFACE_STRIKE_THROUGH(LFACE) \
2424 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2425 #define LFACE_BOX(LFACE) \
2426 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2428 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2429 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2431 #define LFACEP(LFACE) \
2433 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2434 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2439 /* Check consistency of Lisp face attribute vector ATTRS. */
2442 check_lface_attrs (attrs
)
2445 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2446 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2447 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2448 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2449 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2450 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2451 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2452 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2453 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2454 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2455 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2456 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2457 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2458 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2459 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2460 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2461 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2462 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2463 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2464 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2465 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2466 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2467 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2468 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2469 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2470 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2471 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2472 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2473 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2474 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2475 #ifdef HAVE_WINDOW_SYSTEM
2476 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2477 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2478 || !NILP (Fpixmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2483 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2491 xassert (LFACEP (lface
));
2492 check_lface_attrs (XVECTOR (lface
)->contents
);
2496 #else /* GLYPH_DEBUG == 0 */
2498 #define check_lface_attrs(attrs) (void) 0
2499 #define check_lface(lface) (void) 0
2501 #endif /* GLYPH_DEBUG == 0 */
2504 /* Return the face definition of FACE_NAME on frame F. F null means
2505 return the global definition. FACE_NAME may be a string or a
2506 symbol (apparently Emacs 20.2 allows strings as face names in face
2507 text properties; ediff uses that). If SIGNAL_P is non-zero, signal
2508 an error if FACE_NAME is not a valid face name. If SIGNAL_P is
2509 zero, value is nil if FACE_NAME is not a valid face name. */
2511 static INLINE Lisp_Object
2512 lface_from_face_name (f
, face_name
, signal_p
)
2514 Lisp_Object face_name
;
2519 if (STRINGP (face_name
))
2520 face_name
= intern (XSTRING (face_name
)->data
);
2523 lface
= assq_no_quit (face_name
, f
->face_alist
);
2525 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2528 lface
= XCDR (lface
);
2530 signal_error ("Invalid face", face_name
);
2532 check_lface (lface
);
2537 /* Get face attributes of face FACE_NAME from frame-local faces on
2538 frame F. Store the resulting attributes in ATTRS which must point
2539 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2540 is non-zero, signal an error if FACE_NAME does not name a face.
2541 Otherwise, value is zero if FACE_NAME is not a face. */
2544 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2546 Lisp_Object face_name
;
2553 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2556 bcopy (XVECTOR (lface
)->contents
, attrs
,
2557 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2567 /* Non-zero if all attributes in face attribute vector ATTRS are
2568 specified, i.e. are non-nil. */
2571 lface_fully_specified_p (attrs
)
2576 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2577 if (UNSPECIFIEDP (attrs
[i
]))
2580 return i
== LFACE_VECTOR_SIZE
;
2584 #ifdef HAVE_X_WINDOWS
2586 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2587 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2588 LFACE. Ignore fields of FONT_NAME containing wildcards. Value is
2589 zero if not successful because FONT_NAME was not in a valid format.
2590 A valid format is one that is suitable for split_font_name, see the
2594 set_lface_from_font_name (f
, lface
, font_name
, force_p
)
2600 struct font_name font
;
2603 int free_font_name_p
= 0;
2605 /* If FONT_NAME contains wildcards, use the first matching font. */
2606 if (index (font_name
, '*') || index (font_name
, '?'))
2608 if (!first_font_matching (f
, font_name
, &font
))
2610 free_font_name_p
= 1;
2614 font
.name
= STRDUPA (font_name
);
2615 if (!split_font_name (f
, &font
, 1))
2617 /* The font name may be something like `6x13'. Make
2618 sure we use the full name. */
2619 struct font_info
*font_info
;
2622 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2623 CHARSET_ASCII
, font_name
, -1);
2629 font
.name
= STRDUPA (font_info
->full_name
);
2630 split_font_name (f
, &font
, 1);
2633 /* FONT_NAME should not be a fontset name, here. */
2634 xassert (xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0);
2637 /* Set attributes only if unspecified, otherwise face defaults for
2638 new frames would never take effect. */
2640 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2642 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2643 + strlen (font
.fields
[XLFD_FOUNDRY
])
2645 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2646 font
.fields
[XLFD_FAMILY
]);
2647 LFACE_FAMILY (lface
) = build_string (buffer
);
2650 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2652 pt
= xlfd_point_size (f
, &font
);
2654 LFACE_HEIGHT (lface
) = make_number (pt
);
2657 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2658 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2660 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2661 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2663 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2664 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2666 if (free_font_name_p
)
2672 #endif /* HAVE_X_WINDOWS */
2675 /* Merge two Lisp face attribute vectors FROM and TO and store the
2676 resulting attributes in TO. Every non-nil attribute of FROM
2677 overrides the corresponding attribute of TO. */
2680 merge_face_vectors (from
, to
)
2681 Lisp_Object
*from
, *to
;
2684 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2685 if (!UNSPECIFIEDP (from
[i
]))
2690 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2691 is a face property, determine the resulting face attributes on
2692 frame F, and store them in TO. PROP may be a single face
2693 specification or a list of such specifications. Each face
2694 specification can be
2696 1. A symbol or string naming a Lisp face.
2698 2. A property list of the form (KEYWORD VALUE ...) where each
2699 KEYWORD is a face attribute name, and value is an appropriate value
2702 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2703 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2704 for compatibility with 20.2.
2706 Face specifications earlier in lists take precedence over later
2710 merge_face_vector_with_property (f
, to
, prop
)
2717 Lisp_Object first
= XCAR (prop
);
2719 if (EQ (first
, Qforeground_color
)
2720 || EQ (first
, Qbackground_color
))
2722 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2723 . COLOR). COLOR must be a string. */
2724 Lisp_Object color_name
= XCDR (prop
);
2725 Lisp_Object color
= first
;
2727 if (STRINGP (color_name
))
2729 if (EQ (color
, Qforeground_color
))
2730 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2732 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2735 display_message (f
, "Invalid face color", color_name
, Qnil
);
2737 else if (SYMBOLP (first
)
2738 && *XSYMBOL (first
)->name
->data
== ':')
2740 /* Assume this is the property list form. */
2741 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2743 Lisp_Object keyword
= XCAR (prop
);
2744 Lisp_Object value
= XCAR (XCDR (prop
));
2746 if (EQ (keyword
, QCfamily
))
2748 if (STRINGP (value
))
2749 to
[LFACE_FAMILY_INDEX
] = value
;
2751 display_message (f
, "Illegal face font family",
2754 else if (EQ (keyword
, QCheight
))
2756 if (INTEGERP (value
))
2757 to
[LFACE_HEIGHT_INDEX
] = value
;
2759 display_message (f
, "Illegal face font height",
2762 else if (EQ (keyword
, QCweight
))
2765 && face_numeric_weight (value
) >= 0)
2766 to
[LFACE_WEIGHT_INDEX
] = value
;
2768 display_message (f
, "Illegal face weight", value
, Qnil
);
2770 else if (EQ (keyword
, QCslant
))
2773 && face_numeric_slant (value
) >= 0)
2774 to
[LFACE_SLANT_INDEX
] = value
;
2776 display_message (f
, "Illegal face slant", value
, Qnil
);
2778 else if (EQ (keyword
, QCunderline
))
2783 to
[LFACE_UNDERLINE_INDEX
] = value
;
2785 display_message (f
, "Illegal face underline", value
, Qnil
);
2787 else if (EQ (keyword
, QCoverline
))
2792 to
[LFACE_OVERLINE_INDEX
] = value
;
2794 display_message (f
, "Illegal face overline", value
, Qnil
);
2796 else if (EQ (keyword
, QCstrike_through
))
2801 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2803 display_message (f
, "Illegal face strike-through",
2806 else if (EQ (keyword
, QCbox
))
2809 value
= make_number (1);
2810 if (INTEGERP (value
)
2814 to
[LFACE_BOX_INDEX
] = value
;
2816 display_message (f
, "Illegal face box", value
, Qnil
);
2818 else if (EQ (keyword
, QCinverse_video
)
2819 || EQ (keyword
, QCreverse_video
))
2821 if (EQ (value
, Qt
) || NILP (value
))
2822 to
[LFACE_INVERSE_INDEX
] = value
;
2824 display_message (f
, "Illegal face inverse-video",
2827 else if (EQ (keyword
, QCforeground
))
2829 if (STRINGP (value
))
2830 to
[LFACE_FOREGROUND_INDEX
] = value
;
2832 display_message (f
, "Illegal face foreground",
2835 else if (EQ (keyword
, QCbackground
))
2837 if (STRINGP (value
))
2838 to
[LFACE_BACKGROUND_INDEX
] = value
;
2840 display_message (f
, "Illegal face background",
2843 else if (EQ (keyword
, QCstipple
))
2845 #ifdef HAVE_X_WINDOWS
2846 Lisp_Object pixmap_p
= Fpixmap_spec_p (value
);
2847 if (!NILP (pixmap_p
))
2848 to
[LFACE_STIPPLE_INDEX
] = value
;
2850 display_message (f
, "Illegal face stipple", value
, Qnil
);
2853 else if (EQ (keyword
, QCwidth
))
2856 && face_numeric_swidth (value
) >= 0)
2857 to
[LFACE_SWIDTH_INDEX
] = value
;
2859 display_message (f
, "Illegal face width", value
, Qnil
);
2862 display_message (f
, "Invalid attribute %s in face property",
2865 prop
= XCDR (XCDR (prop
));
2870 /* This is a list of face specs. Specifications at the
2871 beginning of the list take precedence over later
2872 specifications, so we have to merge starting with the
2873 last specification. */
2874 Lisp_Object next
= XCDR (prop
);
2876 merge_face_vector_with_property (f
, to
, next
);
2877 merge_face_vector_with_property (f
, to
, first
);
2882 /* PROP ought to be a face name. */
2883 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
2885 display_message (f
, "Invalid face text property value: %s",
2888 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
2893 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2894 Sinternal_make_lisp_face
, 1, 2, 0,
2895 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
2896 If FACE was not known as a face before, create a new one.\n\
2897 If optional argument FRAME is specified, make a frame-local face\n\
2898 for that frame. Otherwise operate on the global face definition.\n\
2899 Value is a vector of face attributes.")
2901 Lisp_Object face
, frame
;
2903 Lisp_Object global_lface
, lface
;
2907 CHECK_SYMBOL (face
, 0);
2908 global_lface
= lface_from_face_name (NULL
, face
, 0);
2912 CHECK_LIVE_FRAME (frame
, 1);
2914 lface
= lface_from_face_name (f
, face
, 0);
2917 f
= NULL
, lface
= Qnil
;
2919 /* Add a global definition if there is none. */
2920 if (NILP (global_lface
))
2922 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2924 XVECTOR (global_lface
)->contents
[0] = Qface
;
2925 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2926 Vface_new_frame_defaults
);
2928 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2929 face id to Lisp face is given by the vector lface_id_to_name.
2930 The mapping from Lisp face to Lisp face id is given by the
2931 property `face' of the Lisp face name. */
2932 if (next_lface_id
== lface_id_to_name_size
)
2934 int new_size
= max (50, 2 * lface_id_to_name_size
);
2935 int sz
= new_size
* sizeof *lface_id_to_name
;
2936 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
2937 lface_id_to_name_size
= new_size
;
2940 lface_id_to_name
[next_lface_id
] = face
;
2941 Fput (face
, Qface
, make_number (next_lface_id
));
2945 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2946 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
2948 /* Add a frame-local definition. */
2953 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2955 XVECTOR (lface
)->contents
[0] = Qface
;
2956 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2959 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2960 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
2963 lface
= global_lface
;
2965 xassert (LFACEP (lface
));
2966 check_lface (lface
);
2971 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2972 Sinternal_lisp_face_p
, 1, 2, 0,
2973 "Return non-nil if FACE names a face.\n\
2974 If optional second parameter FRAME is non-nil, check for the\n\
2975 existence of a frame-local face with name FACE on that frame.\n\
2976 Otherwise check for the existence of a global face.")
2978 Lisp_Object face
, frame
;
2984 CHECK_LIVE_FRAME (frame
, 1);
2985 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2988 lface
= lface_from_face_name (NULL
, face
, 0);
2994 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2995 Sinternal_copy_lisp_face
, 4, 4, 0,
2996 "Copy face FROM to TO.\n\
2997 If FRAME it t, copy the global face definition of FROM to the\n\
2998 global face definition of TO. Otherwise, copy the frame-local\n\
2999 definition of FROM on FRAME to the frame-local definition of TO\n\
3000 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3003 (from
, to
, frame
, new_frame
)
3004 Lisp_Object from
, to
, frame
, new_frame
;
3006 Lisp_Object lface
, copy
;
3008 CHECK_SYMBOL (from
, 0);
3009 CHECK_SYMBOL (to
, 1);
3010 if (NILP (new_frame
))
3015 /* Copy global definition of FROM. We don't make copies of
3016 strings etc. because 20.2 didn't do it either. */
3017 lface
= lface_from_face_name (NULL
, from
, 1);
3018 copy
= Finternal_make_lisp_face (to
, Qnil
);
3022 /* Copy frame-local definition of FROM. */
3023 CHECK_LIVE_FRAME (frame
, 2);
3024 CHECK_LIVE_FRAME (new_frame
, 3);
3025 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3026 copy
= Finternal_make_lisp_face (to
, new_frame
);
3029 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3030 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3036 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3037 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3038 "Set attribute ATTR of FACE to VALUE.\n\
3039 If optional argument FRAME is given, set the face attribute of face FACE\n\
3040 on that frame. If FRAME is t, set the attribute of the default for face\n\
3041 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3043 (face
, attr
, value
, frame
)
3044 Lisp_Object face
, attr
, value
, frame
;
3047 Lisp_Object old_value
= Qnil
;
3048 int font_related_attr_p
= 0;
3050 CHECK_SYMBOL (face
, 0);
3051 CHECK_SYMBOL (attr
, 1);
3053 /* Set lface to the Lisp attribute vector of FACE. */
3055 lface
= lface_from_face_name (NULL
, face
, 1);
3059 XSETFRAME (frame
, selected_frame
);
3061 CHECK_LIVE_FRAME (frame
, 3);
3062 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3064 /* If a frame-local face doesn't exist yet, create one. */
3066 lface
= Finternal_make_lisp_face (face
, frame
);
3069 if (EQ (attr
, QCfamily
))
3071 if (!UNSPECIFIEDP (value
))
3073 CHECK_STRING (value
, 3);
3074 if (XSTRING (value
)->size
== 0)
3075 signal_error ("Invalid face family", value
);
3077 old_value
= LFACE_FAMILY (lface
);
3078 LFACE_FAMILY (lface
) = value
;
3079 font_related_attr_p
= 1;
3081 else if (EQ (attr
, QCheight
))
3083 if (!UNSPECIFIEDP (value
))
3085 CHECK_NUMBER (value
, 3);
3086 if (XINT (value
) <= 0)
3087 signal_error ("Invalid face height", value
);
3089 old_value
= LFACE_HEIGHT (lface
);
3090 LFACE_HEIGHT (lface
) = value
;
3091 font_related_attr_p
= 1;
3093 else if (EQ (attr
, QCweight
))
3095 if (!UNSPECIFIEDP (value
))
3097 CHECK_SYMBOL (value
, 3);
3098 if (face_numeric_weight (value
) < 0)
3099 signal_error ("Invalid face weight", value
);
3101 old_value
= LFACE_WEIGHT (lface
);
3102 LFACE_WEIGHT (lface
) = value
;
3103 font_related_attr_p
= 1;
3105 else if (EQ (attr
, QCslant
))
3107 if (!UNSPECIFIEDP (value
))
3109 CHECK_SYMBOL (value
, 3);
3110 if (face_numeric_slant (value
) < 0)
3111 signal_error ("Invalid face slant", value
);
3113 old_value
= LFACE_SLANT (lface
);
3114 LFACE_SLANT (lface
) = value
;
3115 font_related_attr_p
= 1;
3117 else if (EQ (attr
, QCunderline
))
3119 if (!UNSPECIFIEDP (value
))
3120 if ((SYMBOLP (value
)
3122 && !EQ (value
, Qnil
))
3123 /* Underline color. */
3125 && XSTRING (value
)->size
== 0))
3126 signal_error ("Invalid face underline", value
);
3128 old_value
= LFACE_UNDERLINE (lface
);
3129 LFACE_UNDERLINE (lface
) = value
;
3131 else if (EQ (attr
, QCoverline
))
3133 if (!UNSPECIFIEDP (value
))
3134 if ((SYMBOLP (value
)
3136 && !EQ (value
, Qnil
))
3137 /* Overline color. */
3139 && XSTRING (value
)->size
== 0))
3140 signal_error ("Invalid face overline", value
);
3142 old_value
= LFACE_OVERLINE (lface
);
3143 LFACE_OVERLINE (lface
) = value
;
3145 else if (EQ (attr
, QCstrike_through
))
3147 if (!UNSPECIFIEDP (value
))
3148 if ((SYMBOLP (value
)
3150 && !EQ (value
, Qnil
))
3151 /* Strike-through color. */
3153 && XSTRING (value
)->size
== 0))
3154 signal_error ("Invalid face strike-through", value
);
3156 old_value
= LFACE_STRIKE_THROUGH (lface
);
3157 LFACE_STRIKE_THROUGH (lface
) = value
;
3159 else if (EQ (attr
, QCbox
))
3163 /* Allow t meaning a simple box of width 1 in foreground color
3166 value
= make_number (1);
3168 if (UNSPECIFIEDP (value
))
3170 else if (NILP (value
))
3172 else if (INTEGERP (value
))
3173 valid_p
= XINT (value
) > 0;
3174 else if (STRINGP (value
))
3175 valid_p
= XSTRING (value
)->size
> 0;
3176 else if (CONSP (value
))
3192 if (EQ (k
, QCline_width
))
3194 if (!INTEGERP (v
) || XINT (v
) <= 0)
3197 else if (EQ (k
, QCcolor
))
3199 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3202 else if (EQ (k
, QCstyle
))
3204 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3211 valid_p
= NILP (tem
);
3217 signal_error ("Invalid face box", value
);
3219 old_value
= LFACE_BOX (lface
);
3220 LFACE_BOX (lface
) = value
;
3222 else if (EQ (attr
, QCinverse_video
)
3223 || EQ (attr
, QCreverse_video
))
3225 if (!UNSPECIFIEDP (value
))
3227 CHECK_SYMBOL (value
, 3);
3228 if (!EQ (value
, Qt
) && !NILP (value
))
3229 signal_error ("Invalid inverse-video face attribute value", value
);
3231 old_value
= LFACE_INVERSE (lface
);
3232 LFACE_INVERSE (lface
) = value
;
3234 else if (EQ (attr
, QCforeground
))
3236 if (!UNSPECIFIEDP (value
))
3238 /* Don't check for valid color names here because it depends
3239 on the frame (display) whether the color will be valid
3240 when the face is realized. */
3241 CHECK_STRING (value
, 3);
3242 if (XSTRING (value
)->size
== 0)
3243 signal_error ("Empty foreground color value", value
);
3245 old_value
= LFACE_FOREGROUND (lface
);
3246 LFACE_FOREGROUND (lface
) = value
;
3248 else if (EQ (attr
, QCbackground
))
3250 if (!UNSPECIFIEDP (value
))
3252 /* Don't check for valid color names here because it depends
3253 on the frame (display) whether the color will be valid
3254 when the face is realized. */
3255 CHECK_STRING (value
, 3);
3256 if (XSTRING (value
)->size
== 0)
3257 signal_error ("Empty background color value", value
);
3259 old_value
= LFACE_BACKGROUND (lface
);
3260 LFACE_BACKGROUND (lface
) = value
;
3262 else if (EQ (attr
, QCstipple
))
3264 #ifdef HAVE_X_WINDOWS
3265 if (!UNSPECIFIEDP (value
)
3267 && NILP (Fpixmap_spec_p (value
)))
3268 signal_error ("Invalid stipple attribute", value
);
3269 old_value
= LFACE_STIPPLE (lface
);
3270 LFACE_STIPPLE (lface
) = value
;
3271 #endif /* HAVE_X_WINDOWS */
3273 else if (EQ (attr
, QCwidth
))
3275 if (!UNSPECIFIEDP (value
))
3277 CHECK_SYMBOL (value
, 3);
3278 if (face_numeric_swidth (value
) < 0)
3279 signal_error ("Invalid face width", value
);
3281 old_value
= LFACE_SWIDTH (lface
);
3282 LFACE_SWIDTH (lface
) = value
;
3283 font_related_attr_p
= 1;
3285 else if (EQ (attr
, QCfont
))
3287 #ifdef HAVE_X_WINDOWS
3288 /* Set font-related attributes of the Lisp face from an
3292 CHECK_STRING (value
, 3);
3296 f
= check_x_frame (frame
);
3298 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1))
3299 signal_error ("Invalid font name", value
);
3301 font_related_attr_p
= 1;
3302 #endif /* HAVE_X_WINDOWS */
3304 else if (EQ (attr
, QCbold
))
3306 old_value
= LFACE_WEIGHT (lface
);
3307 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3308 font_related_attr_p
= 1;
3310 else if (EQ (attr
, QCitalic
))
3312 old_value
= LFACE_SLANT (lface
);
3313 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3314 font_related_attr_p
= 1;
3317 signal_error ("Invalid face attribute name", attr
);
3319 /* Changing a named face means that all realized faces depending on
3320 that face are invalid. Since we cannot tell which realized faces
3321 depend on the face, make sure they are all removed. This is done
3322 by incrementing face_change_count. The next call to
3323 init_iterator will then free realized faces. */
3325 && (EQ (attr
, QCfont
)
3326 || NILP (Fequal (old_value
, value
))))
3328 ++face_change_count
;
3329 ++windows_or_buffers_changed
;
3332 #ifdef HAVE_X_WINDOWS
3333 /* Changed font-related attributes of the `default' face are
3334 reflected in changed `font' frame parameters. */
3335 if (EQ (face
, Qdefault
)
3337 && font_related_attr_p
3338 && lface_fully_specified_p (XVECTOR (lface
)->contents
)
3339 && NILP (Fequal (old_value
, value
)))
3340 set_font_frame_param (frame
, lface
);
3342 #endif /* HAVE_X_WINDOWS */
3348 #ifdef HAVE_X_WINDOWS
3350 /* Set the `font' frame parameter of FRAME according to `default' face
3351 attributes LFACE. */
3354 set_font_frame_param (frame
, lface
)
3355 Lisp_Object frame
, lface
;
3357 struct frame
*f
= XFRAME (frame
);
3358 Lisp_Object frame_font
;
3362 /* Get FRAME's font parameter. */
3363 frame_font
= Fassq (Qfont
, f
->param_alist
);
3364 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3365 frame_font
= XCDR (frame_font
);
3367 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3370 /* Frame parameter is a fontset name. Modify the fontset so
3371 that all its fonts reflect face attributes LFACE. */
3373 struct fontset_info
*fontset_info
;
3375 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3377 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3378 if (fontset_info
->fontname
[charset
])
3380 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3382 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3383 build_string (font
), frame
);
3389 /* Frame parameter is an X font name. I believe this can
3390 only happen in unibyte mode. */
3391 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3392 -1, Vface_default_registry
);
3395 store_frame_param (f
, Qfont
, build_string (font
));
3402 /* Get the value of X resource RESOURCE, class CLASS for the display
3403 of frame FRAME. This is here because ordinary `x-get-resource'
3404 doesn't take a frame argument. */
3406 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3407 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3408 (resource
, class, frame
)
3409 Lisp_Object resource
, class, frame
;
3412 CHECK_STRING (resource
, 0);
3413 CHECK_STRING (class, 1);
3414 CHECK_LIVE_FRAME (frame
, 2);
3416 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3417 resource
, class, Qnil
, Qnil
);
3423 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3424 If VALUE is "on" or "true", return t. If VALUE is "off" or
3425 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3426 error; if SIGNAL_P is zero, return 0. */
3429 face_boolean_x_resource_value (value
, signal_p
)
3433 Lisp_Object result
= make_number (0);
3435 xassert (STRINGP (value
));
3437 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3438 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3440 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3441 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3443 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3444 result
= Qunspecified
;
3446 signal_error ("Invalid face attribute value from X resource", value
);
3452 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3453 Finternal_set_lisp_face_attribute_from_resource
,
3454 Sinternal_set_lisp_face_attribute_from_resource
,
3456 (face
, attr
, value
, frame
)
3457 Lisp_Object face
, attr
, value
, frame
;
3459 CHECK_SYMBOL (face
, 0);
3460 CHECK_SYMBOL (attr
, 1);
3461 CHECK_STRING (value
, 2);
3463 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3464 value
= Qunspecified
;
3465 else if (EQ (attr
, QCheight
))
3467 value
= Fstring_to_number (value
, make_number (10));
3468 if (XINT (value
) <= 0)
3469 signal_error ("Invalid face height from X resource", value
);
3471 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3472 value
= face_boolean_x_resource_value (value
, 1);
3473 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3474 value
= intern (XSTRING (value
)->data
);
3475 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3476 value
= face_boolean_x_resource_value (value
, 1);
3477 else if (EQ (attr
, QCunderline
)
3478 || EQ (attr
, QCoverline
)
3479 || EQ (attr
, QCstrike_through
)
3480 || EQ (attr
, QCbox
))
3482 Lisp_Object boolean_value
;
3484 /* If the result of face_boolean_x_resource_value is t or nil,
3485 VALUE does NOT specify a color. */
3486 boolean_value
= face_boolean_x_resource_value (value
, 0);
3487 if (SYMBOLP (boolean_value
))
3488 value
= boolean_value
;
3491 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3495 #endif /* HAVE_X_WINDOWS */
3499 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3500 Sinternal_get_lisp_face_attribute
,
3502 "Return face attribute KEYWORD of face SYMBOL.\n\
3503 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
3504 face attribute name, signal an error.\n\
3505 If the optional argument FRAME is given, report on face FACE in that\n\
3506 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
3507 frames). If FRAME is omitted or nil, use the selected frame.")
3508 (symbol
, keyword
, frame
)
3509 Lisp_Object symbol
, keyword
, frame
;
3511 Lisp_Object lface
, value
= Qnil
;
3513 CHECK_SYMBOL (symbol
, 0);
3514 CHECK_SYMBOL (keyword
, 1);
3517 lface
= lface_from_face_name (NULL
, symbol
, 1);
3521 XSETFRAME (frame
, selected_frame
);
3522 CHECK_LIVE_FRAME (frame
, 2);
3523 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3526 if (EQ (keyword
, QCfamily
))
3527 value
= LFACE_FAMILY (lface
);
3528 else if (EQ (keyword
, QCheight
))
3529 value
= LFACE_HEIGHT (lface
);
3530 else if (EQ (keyword
, QCweight
))
3531 value
= LFACE_WEIGHT (lface
);
3532 else if (EQ (keyword
, QCslant
))
3533 value
= LFACE_SLANT (lface
);
3534 else if (EQ (keyword
, QCunderline
))
3535 value
= LFACE_UNDERLINE (lface
);
3536 else if (EQ (keyword
, QCoverline
))
3537 value
= LFACE_OVERLINE (lface
);
3538 else if (EQ (keyword
, QCstrike_through
))
3539 value
= LFACE_STRIKE_THROUGH (lface
);
3540 else if (EQ (keyword
, QCbox
))
3541 value
= LFACE_BOX (lface
);
3542 else if (EQ (keyword
, QCinverse_video
)
3543 || EQ (keyword
, QCreverse_video
))
3544 value
= LFACE_INVERSE (lface
);
3545 else if (EQ (keyword
, QCforeground
))
3546 value
= LFACE_FOREGROUND (lface
);
3547 else if (EQ (keyword
, QCbackground
))
3548 value
= LFACE_BACKGROUND (lface
);
3549 else if (EQ (keyword
, QCstipple
))
3550 value
= LFACE_STIPPLE (lface
);
3551 else if (EQ (keyword
, QCwidth
))
3552 value
= LFACE_SWIDTH (lface
);
3554 signal_error ("Invalid face attribute name", keyword
);
3560 DEFUN ("internal-lisp-face-attribute-values",
3561 Finternal_lisp_face_attribute_values
,
3562 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3563 "Return a list of valid discrete values for face attribute ATTR.\n\
3564 Value is nil if ATTR doesn't have a discrete set of valid values.")
3568 Lisp_Object result
= Qnil
;
3570 CHECK_SYMBOL (attr
, 0);
3572 if (EQ (attr
, QCweight
)
3573 || EQ (attr
, QCslant
)
3574 || EQ (attr
, QCwidth
))
3576 /* Extract permissible symbols from tables. */
3577 struct table_entry
*table
;
3580 if (EQ (attr
, QCweight
))
3581 table
= weight_table
, dim
= DIM (weight_table
);
3582 else if (EQ (attr
, QCslant
))
3583 table
= slant_table
, dim
= DIM (slant_table
);
3585 table
= swidth_table
, dim
= DIM (swidth_table
);
3587 for (i
= 0; i
< dim
; ++i
)
3589 Lisp_Object symbol
= *table
[i
].symbol
;
3590 Lisp_Object tail
= result
;
3593 && !EQ (XCAR (tail
), symbol
))
3597 result
= Fcons (symbol
, result
);
3600 else if (EQ (attr
, QCunderline
))
3601 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3602 else if (EQ (attr
, QCoverline
))
3603 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3604 else if (EQ (attr
, QCstrike_through
))
3605 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3606 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3607 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3613 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3614 Sinternal_merge_in_global_face
, 2, 2, 0,
3615 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
3617 Lisp_Object face
, frame
;
3619 Lisp_Object global_lface
, local_lface
;
3620 CHECK_LIVE_FRAME (frame
, 1);
3621 global_lface
= lface_from_face_name (NULL
, face
, 1);
3622 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3623 if (NILP (local_lface
))
3624 local_lface
= Finternal_make_lisp_face (face
, frame
);
3625 merge_face_vectors (XVECTOR (global_lface
)->contents
,
3626 XVECTOR (local_lface
)->contents
);
3631 /* The following function is implemented for compatibility with 20.2.
3632 The function is used in x-resolve-fonts when it is asked to
3633 return fonts with the same size as the font of a face. This is
3634 done in fontset.el. */
3636 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
3637 "Return the font name of face FACE, or nil if it is unspecified.\n\
3638 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3639 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3640 The font default for a face is either nil, or a list\n\
3641 of the form (bold), (italic) or (bold italic).\n\
3642 If FRAME is omitted or nil, use the selected frame.")
3644 Lisp_Object face
, frame
;
3648 Lisp_Object result
= Qnil
;
3649 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3651 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3652 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3653 result
= Fcons (Qbold
, result
);
3655 if (!NILP (LFACE_SLANT (lface
))
3656 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3657 result
= Fcons (Qitalic
, result
);
3663 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3664 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
3665 struct face
*face
= FACE_FROM_ID (f
, face_id
);
3666 return build_string (face
->font_name
);
3671 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3672 all attributes are `equal'. Tries to be fast because this function
3673 is called quite often. */
3676 lface_equal_p (v1
, v2
)
3677 Lisp_Object
*v1
, *v2
;
3681 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3683 Lisp_Object a
= v1
[i
];
3684 Lisp_Object b
= v2
[i
];
3686 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3687 and the other is specified. */
3688 equal_p
= XTYPE (a
) == XTYPE (b
);
3697 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
3698 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
3699 XSTRING (a
)->size
) == 0);
3708 equal_p
= !NILP (Fequal (a
, b
));
3718 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3719 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3720 "True if FACE1 and FACE2 are equal.\n\
3721 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3722 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3723 If FRAME is omitted or nil, use the selected frame.")
3724 (face1
, face2
, frame
)
3725 Lisp_Object face1
, face2
, frame
;
3729 Lisp_Object lface1
, lface2
;
3734 /* Don't use check_x_frame here because this function is called
3735 before X frames exist. At that time, if FRAME is nil,
3736 selected_frame will be used which is the frame dumped with
3737 Emacs. That frame is not an X frame. */
3738 f
= frame_or_selected_frame (frame
, 2);
3740 lface1
= lface_from_face_name (NULL
, face1
, 1);
3741 lface2
= lface_from_face_name (NULL
, face2
, 1);
3742 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
3743 XVECTOR (lface2
)->contents
);
3744 return equal_p
? Qt
: Qnil
;
3748 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3749 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3750 "True if FACE has no attribute specified.\n\
3751 If the optional argument FRAME is given, report on face FACE in that frame.\n\
3752 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
3753 If FRAME is omitted or nil, use the selected frame.")
3755 Lisp_Object face
, frame
;
3765 CHECK_LIVE_FRAME (frame
, 0);
3770 lface
= lface_from_face_name (NULL
, face
, 1);
3772 lface
= lface_from_face_name (f
, face
, 1);
3774 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3775 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
3778 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
3782 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
3784 "Return an alist of frame-local faces defined on FRAME.\n\
3785 For internal use only.")
3789 struct frame
*f
= frame_or_selected_frame (frame
, 0);
3790 return f
->face_alist
;
3794 /* Return a hash code for Lisp string STRING with case ignored. Used
3795 below in computing a hash value for a Lisp face. */
3797 static INLINE
unsigned
3798 hash_string_case_insensitive (string
)
3803 xassert (STRINGP (string
));
3804 for (s
= XSTRING (string
)->data
; *s
; ++s
)
3805 hash
= (hash
<< 1) ^ tolower (*s
);
3810 /* Return a hash code for face attribute vector V. */
3812 static INLINE
unsigned
3816 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
3817 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
3818 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
3819 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
3820 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
3821 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
3822 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
3826 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
3827 considering charsets/registries). They do if they specify the same
3828 family, point size, weight, width and slant. Both LFACE1 and
3829 LFACE2 must be fully-specified. */
3832 lface_same_font_attributes_p (lface1
, lface2
)
3833 Lisp_Object
*lface1
, *lface2
;
3835 xassert (lface_fully_specified_p (lface1
)
3836 && lface_fully_specified_p (lface2
));
3837 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
3838 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
3839 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
3840 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
3841 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
3842 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
3843 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
3848 /***********************************************************************
3850 ***********************************************************************/
3852 /* Allocate and return a new realized face for Lisp face attribute
3853 vector ATTR, charset CHARSET, and registry REGISTRY. */
3855 static struct face
*
3856 make_realized_face (attr
, charset
, registry
)
3859 Lisp_Object registry
;
3861 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
3862 bzero (face
, sizeof *face
);
3863 face
->charset
= charset
;
3864 face
->registry
= registry
;
3865 bcopy (attr
, face
->lface
, sizeof face
->lface
);
3870 /* Free realized face FACE, including its X resources. FACE may
3874 free_realized_face (f
, face
)
3880 #ifdef HAVE_X_WINDOWS
3885 x_free_gc (f
, face
->gc
);
3889 free_face_colors (f
, face
);
3890 x_destroy_bitmap (f
, face
->stipple
);
3892 #endif /* HAVE_X_WINDOWS */
3899 /* Prepare face FACE for subsequent display on frame F. This
3900 allocated GCs if they haven't been allocated yet or have been freed
3901 by clearing the face cache. */
3904 prepare_face_for_display (f
, face
)
3908 #ifdef HAVE_X_WINDOWS
3909 xassert (FRAME_X_P (f
));
3914 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
3916 xgcv
.foreground
= face
->foreground
;
3917 xgcv
.background
= face
->background
;
3918 xgcv
.graphics_exposures
= False
;
3920 /* The font of FACE may be null if we couldn't load it. */
3923 xgcv
.font
= face
->font
->fid
;
3930 xgcv
.fill_style
= FillOpaqueStippled
;
3931 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
3932 mask
|= GCFillStyle
| GCStipple
;
3935 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
3942 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
3943 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
3944 ISO8859-1 if the ASCII face suffices. */
3947 face_suitable_for_iso8859_1_p (face
)
3950 int len
= strlen (face
->font_name
);
3951 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
3955 /* Value is non-zero if FACE is suitable for displaying characters
3956 of CHARSET. CHARSET < 0 means unibyte text. */
3959 face_suitable_for_charset_p (face
, charset
)
3967 if (EQ (face
->registry
, Vface_default_registry
)
3968 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
3971 else if (face
->charset
== charset
)
3973 else if (face
->charset
== CHARSET_ASCII
3974 && charset
== charset_latin_iso8859_1
)
3975 suitable_p
= face_suitable_for_iso8859_1_p (face
);
3976 else if (face
->charset
== charset_latin_iso8859_1
3977 && charset
== CHARSET_ASCII
)
3985 /***********************************************************************
3987 ***********************************************************************/
3989 /* Return a new face cache for frame F. */
3991 static struct face_cache
*
3995 struct face_cache
*c
;
3998 c
= (struct face_cache
*) xmalloc (sizeof *c
);
3999 bzero (c
, sizeof *c
);
4000 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4001 c
->buckets
= (struct face
**) xmalloc (size
);
4002 bzero (c
->buckets
, size
);
4004 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4010 /* Clear out all graphics contexts for all realized faces, except for
4011 the basic faces. This should be done from time to time just to avoid
4012 keeping too many graphics contexts that are no longer needed. */
4016 struct face_cache
*c
;
4018 if (c
&& FRAME_X_P (c
->f
))
4020 #ifdef HAVE_X_WINDOWS
4022 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4024 struct face
*face
= c
->faces_by_id
[i
];
4025 if (face
&& face
->gc
)
4027 x_free_gc (c
->f
, face
->gc
);
4031 #endif /* HAVE_X_WINDOWS */
4036 /* Free all realized faces in face cache C, including basic faces. C
4037 may be null. If faces are freed, make sure the frame's current
4038 matrix is marked invalid, so that a display caused by an expose
4039 event doesn't try to use faces we destroyed. */
4042 free_realized_faces (c
)
4043 struct face_cache
*c
;
4048 struct frame
*f
= c
->f
;
4050 for (i
= 0; i
< c
->used
; ++i
)
4052 free_realized_face (f
, c
->faces_by_id
[i
]);
4053 c
->faces_by_id
[i
] = NULL
;
4057 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4058 bzero (c
->buckets
, size
);
4060 /* Must do a thorough redisplay the next time. Mark current
4061 matrices as invalid because they will reference faces freed
4062 above. This function is also called when a frame is
4063 destroyed. In this case, the root window of F is nil. */
4064 if (WINDOWP (f
->root_window
))
4066 clear_current_matrices (f
);
4067 ++windows_or_buffers_changed
;
4073 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4074 This is done after attributes of a named face have been changed,
4075 because we can't tell which realized faces depend on that face. */
4078 free_all_realized_faces (frame
)
4084 FOR_EACH_FRAME (rest
, frame
)
4085 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4088 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4092 /* Free face cache C and faces in it, including their X resources. */
4096 struct face_cache
*c
;
4100 free_realized_faces (c
);
4102 xfree (c
->faces_by_id
);
4108 /* Cache realized face FACE in face cache C. HASH is the hash value
4109 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4110 collision list of the face hash table of C. This is done because
4111 otherwise lookup_face would find FACE for every charset, even if
4112 faces with the same attributes but for specific charsets exist. */
4115 cache_face (c
, face
, hash
)
4116 struct face_cache
*c
;
4120 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4124 if (face
->fontset
>= 0)
4126 struct face
*last
= c
->buckets
[i
];
4137 c
->buckets
[i
] = face
;
4138 face
->prev
= face
->next
= NULL
;
4144 face
->next
= c
->buckets
[i
];
4146 face
->next
->prev
= face
;
4147 c
->buckets
[i
] = face
;
4150 /* Find a free slot in C->faces_by_id and use the index of the free
4151 slot as FACE->id. */
4152 for (i
= 0; i
< c
->used
; ++i
)
4153 if (c
->faces_by_id
[i
] == NULL
)
4157 /* Maybe enlarge C->faces_by_id. */
4158 if (i
== c
->used
&& c
->used
== c
->size
)
4160 int new_size
= 2 * c
->size
;
4161 int sz
= new_size
* sizeof *c
->faces_by_id
;
4162 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4167 /* Check that FACE got a unique id. */
4172 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4173 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4179 #endif /* GLYPH_DEBUG */
4181 c
->faces_by_id
[i
] = face
;
4187 /* Remove face FACE from cache C. */
4190 uncache_face (c
, face
)
4191 struct face_cache
*c
;
4194 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4197 face
->prev
->next
= face
->next
;
4199 c
->buckets
[i
] = face
->next
;
4202 face
->next
->prev
= face
->prev
;
4204 c
->faces_by_id
[face
->id
] = NULL
;
4205 if (face
->id
== c
->used
)
4210 /* Look up a realized face with face attributes ATTR in the face cache
4211 of frame F. The face will be used to display characters of
4212 CHARSET. CHARSET < 0 means the face will be used to display
4213 unibyte text. The value of face-default-registry is used to choose
4214 a font for the face in that case. Value is the ID of the face
4215 found. If no suitable face is found, realize a new one. */
4218 lookup_face (f
, attr
, charset
)
4223 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4228 xassert (c
!= NULL
);
4229 check_lface_attrs (attr
);
4231 /* Look up ATTR in the face cache. */
4232 hash
= lface_hash (attr
);
4233 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4235 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4236 if (face
->hash
== hash
4237 && (FRAME_TERMCAP_P (f
)
4238 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4239 && lface_equal_p (face
->lface
, attr
))
4242 /* If not found, realize a new face. */
4245 face
= realize_face (c
, attr
, charset
);
4246 cache_face (c
, face
, hash
);
4250 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4252 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4253 #endif /* GLYPH_DEBUG */
4259 /* Return the face id of the realized face for named face SYMBOL on
4260 frame F suitable for displaying characters from CHARSET. CHARSET <
4261 0 means unibyte text. */
4264 lookup_named_face (f
, symbol
, charset
)
4269 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4270 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4271 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4273 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4274 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4275 merge_face_vectors (symbol_attrs
, attrs
);
4276 return lookup_face (f
, attrs
, charset
);
4280 /* Return the ID of the realized ASCII face of Lisp face with ID
4281 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4284 ascii_face_of_lisp_face (f
, lface_id
)
4290 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4292 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4293 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4302 /* Return a face for charset ASCII that is like the face with id
4303 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4304 STEPS < 0 means larger. Value is the id of the face. */
4307 smaller_face (f
, face_id
, steps
)
4311 #ifdef HAVE_X_WINDOWS
4313 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4314 int pt
, last_pt
, last_height
;
4317 struct face
*new_face
;
4319 /* If not called for an X frame, just return the original face. */
4320 if (FRAME_TERMCAP_P (f
))
4323 /* Try in increments of 1/2 pt. */
4324 delta
= steps
< 0 ? 5 : -5;
4325 steps
= abs (steps
);
4327 face
= FACE_FROM_ID (f
, face_id
);
4328 bcopy (face
->lface
, attrs
, sizeof attrs
);
4329 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4330 new_face_id
= face_id
;
4331 last_height
= FONT_HEIGHT (face
->font
);
4335 /* Give up if we cannot find a font within 10pt. */
4336 && abs (last_pt
- pt
) < 100)
4338 /* Look up a face for a slightly smaller/larger font. */
4340 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4341 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4342 new_face
= FACE_FROM_ID (f
, new_face_id
);
4344 /* If height changes, count that as one step. */
4345 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4348 last_height
= FONT_HEIGHT (new_face
->font
);
4355 #else /* not HAVE_X_WINDOWS */
4359 #endif /* not HAVE_X_WINDOWS */
4363 /* Return a face for charset ASCII that is like the face with id
4364 FACE_ID on frame F, but has height HEIGHT. */
4367 face_with_height (f
, face_id
, height
)
4372 #ifdef HAVE_X_WINDOWS
4374 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4376 if (FRAME_TERMCAP_P (f
)
4380 face
= FACE_FROM_ID (f
, face_id
);
4381 bcopy (face
->lface
, attrs
, sizeof attrs
);
4382 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4383 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4384 #endif /* HAVE_X_WINDOWS */
4391 /***********************************************************************
4393 ***********************************************************************/
4395 DEFUN ("internal-set-font-selection-order",
4396 Finternal_set_font_selection_order
,
4397 Sinternal_set_font_selection_order
, 1, 1, 0,
4398 "Set font selection order for face font selection to ORDER.\n\
4399 ORDER must be a list of length 4 containing the symbols `:width',\n\
4400 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4401 first in ORDER are matched first, e.g. if `:height' appears before\n\
4402 `:weight' in ORDER, font selection first tries to find a font with\n\
4403 a suitable height, and then tries to match the font weight.\n\
4412 CHECK_LIST (order
, 0);
4413 bzero (indices
, sizeof indices
);
4417 CONSP (list
) && i
< DIM (indices
);
4418 list
= XCDR (list
), ++i
)
4420 Lisp_Object attr
= XCAR (list
);
4423 if (EQ (attr
, QCwidth
))
4425 else if (EQ (attr
, QCheight
))
4426 xlfd
= XLFD_POINT_SIZE
;
4427 else if (EQ (attr
, QCweight
))
4429 else if (EQ (attr
, QCslant
))
4434 if (indices
[i
] != 0)
4440 || i
!= DIM (indices
)
4445 signal_error ("Invalid font sort order", order
);
4447 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4449 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4450 free_all_realized_faces (Qnil
);
4457 DEFUN ("internal-set-alternative-font-family-alist",
4458 Finternal_set_alternative_font_family_alist
,
4459 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
4460 "Define alternative font families to try in face font selection.\n\
4461 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4462 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
4463 be found. Value is ALIST.")
4467 CHECK_LIST (alist
, 0);
4468 Vface_alternative_font_family_alist
= alist
;
4469 free_all_realized_faces (Qnil
);
4474 #ifdef HAVE_X_WINDOWS
4476 /* Return the X registry and encoding of font name FONT_NAME on frame F.
4477 Value is nil if not successful. */
4480 deduce_unibyte_registry (f
, font_name
)
4484 struct font_name font
;
4485 Lisp_Object registry
= Qnil
;
4487 font
.name
= STRDUPA (font_name
);
4488 if (split_font_name (f
, &font
, 0))
4492 /* Extract registry and encoding. */
4493 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
4494 + strlen (font
.fields
[XLFD_ENCODING
])
4496 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
4497 strcat (buffer
, "-");
4498 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
4499 registry
= build_string (buffer
);
4506 /* Value is non-zero if FONT is the name of a scalable font. The
4507 X11R6 XLFD spec says that point size, pixel size, and average width
4508 are zero for scalable fonts. Intlfonts contain at least one
4509 scalable font ("*-muleindian-1") for which this isn't true, so we
4510 just test average width. */
4513 font_scalable_p (font
)
4514 struct font_name
*font
;
4516 char *s
= font
->fields
[XLFD_AVGWIDTH
];
4517 return *s
== '0' && *(s
+ 1) == '\0';
4521 /* Value is non-zero if FONT1 is a better match for font attributes
4522 VALUES than FONT2. VALUES is an array of face attribute values in
4523 font sort order. COMPARE_PT_P zero means don't compare point
4527 better_font_p (values
, font1
, font2
, compare_pt_p
)
4529 struct font_name
*font1
, *font2
;
4534 for (i
= 0; i
< 4; ++i
)
4536 int xlfd_idx
= font_sort_order
[i
];
4538 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
4540 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
4541 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
4543 if (delta1
> delta2
)
4545 else if (delta1
< delta2
)
4549 /* The difference may be equal because, e.g., the face
4550 specifies `italic' but we have only `regular' and
4551 `oblique'. Prefer `oblique' in this case. */
4552 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
4553 && font1
->numeric
[xlfd_idx
] > values
[i
]
4554 && font2
->numeric
[xlfd_idx
] < values
[i
])
4566 /* Value is non-zero if FONT is an exact match for face attributes in
4567 SPECIFIED. SPECIFIED is an array of face attribute values in font
4571 exact_face_match_p (specified
, font
)
4573 struct font_name
*font
;
4577 for (i
= 0; i
< 4; ++i
)
4578 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
4585 /* Value is the name of a scaled font, generated from scalable font
4586 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
4587 Value is allocated from heap. */
4590 build_scalable_font_name (f
, font
, specified_pt
)
4592 struct font_name
*font
;
4595 char point_size
[20], pixel_size
[20];
4597 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
4600 /* If scalable font is for a specific resolution, compute
4601 the point size we must specify from the resolution of
4602 the display and the specified resolution of the font. */
4603 if (font
->numeric
[XLFD_RESY
] != 0)
4605 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
4606 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
4611 pixel_value
= resy
/ 720.0 * pt
;
4614 /* Set point size of the font. */
4615 sprintf (point_size
, "%d", (int) pt
);
4616 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
4617 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
4619 /* Set pixel size. */
4620 sprintf (pixel_size
, "%d", pixel_value
);
4621 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
4622 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
4624 /* If font doesn't specify its resolution, use the
4625 resolution of the display. */
4626 if (font
->numeric
[XLFD_RESY
] == 0)
4629 sprintf (buffer
, "%d", (int) resy
);
4630 font
->fields
[XLFD_RESY
] = buffer
;
4631 font
->numeric
[XLFD_RESY
] = resy
;
4634 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
4637 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
4638 sprintf (buffer
, "%d", resx
);
4639 font
->fields
[XLFD_RESX
] = buffer
;
4640 font
->numeric
[XLFD_RESX
] = resx
;
4643 return build_font_name (font
);
4647 /* Value is non-zero if we are allowed to use scalable font FONT. We
4648 can't run a Lisp function here since this function may be called
4649 with input blocked. */
4652 may_use_scalable_font_p (font
, name
)
4653 struct font_name
*font
;
4656 if (EQ (Vscalable_fonts_allowed
, Qt
))
4658 else if (CONSP (Vscalable_fonts_allowed
))
4660 Lisp_Object tail
, regexp
;
4662 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
4664 regexp
= XCAR (tail
);
4665 if (STRINGP (regexp
)
4666 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
4674 #endif /* SCALABLE_FONTS != 0 */
4677 /* Return the name of the best matching font for face attributes
4678 ATTRS in the array of font_name structures FONTS which contains
4679 NFONTS elements. Value is a font name which is allocated from
4680 the heap. FONTS is freed by this function. */
4683 best_matching_font (f
, attrs
, fonts
, nfonts
)
4686 struct font_name
*fonts
;
4690 struct font_name
*best
;
4698 /* Make specified font attributes available in `specified',
4699 indexed by sort order. */
4700 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
4702 int xlfd_idx
= font_sort_order
[i
];
4704 if (xlfd_idx
== XLFD_SWIDTH
)
4705 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
4706 else if (xlfd_idx
== XLFD_POINT_SIZE
)
4707 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4708 else if (xlfd_idx
== XLFD_WEIGHT
)
4709 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
4710 else if (xlfd_idx
== XLFD_SLANT
)
4711 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
4721 /* Start with the first non-scalable font in the list. */
4722 for (i
= 0; i
< nfonts
; ++i
)
4723 if (!font_scalable_p (fonts
+ i
))
4726 /* Find the best match among the non-scalable fonts. */
4731 for (i
= 1; i
< nfonts
; ++i
)
4732 if (!font_scalable_p (fonts
+ i
)
4733 && better_font_p (specified
, fonts
+ i
, best
, 1))
4737 exact_p
= exact_face_match_p (specified
, best
);
4746 /* Unless we found an exact match among non-scalable fonts, see if
4747 we can find a better match among scalable fonts. */
4750 /* A scalable font is better if
4752 1. its weight, slant, swidth attributes are better, or.
4754 2. the best non-scalable font doesn't have the required
4755 point size, and the scalable fonts weight, slant, swidth
4758 int non_scalable_has_exact_height_p
;
4760 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
4761 non_scalable_has_exact_height_p
= 1;
4763 non_scalable_has_exact_height_p
= 0;
4765 for (i
= 0; i
< nfonts
; ++i
)
4766 if (font_scalable_p (fonts
+ i
))
4769 || better_font_p (specified
, fonts
+ i
, best
, 0)
4770 || (!non_scalable_has_exact_height_p
4771 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
4776 if (font_scalable_p (best
))
4777 font_name
= build_scalable_font_name (f
, best
, pt
);
4779 font_name
= build_font_name (best
);
4781 #else /* !SCALABLE_FONTS */
4783 /* Find the best non-scalable font. */
4786 for (i
= 1; i
< nfonts
; ++i
)
4788 xassert (!font_scalable_p (fonts
+ i
));
4789 if (better_font_p (specified
, fonts
+ i
, best
, 1))
4793 font_name
= build_font_name (best
);
4795 #endif /* !SCALABLE_FONTS */
4797 /* Free font_name structures. */
4798 free_font_names (fonts
, nfonts
);
4804 /* Try to get a list of fonts on frame F with font family FAMILY and
4805 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
4806 of font_name structures for the fonts matched. Value is the number
4810 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
4813 char *pattern
, *family
, *registry
;
4814 struct font_name
**fonts
;
4819 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
4821 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
4827 /* Try alternative font families from
4828 Vface_alternative_font_family_alist. */
4829 alter
= Fassoc (build_string (family
),
4830 Vface_alternative_font_family_alist
);
4832 for (alter
= XCDR (alter
);
4833 CONSP (alter
) && nfonts
== 0;
4834 alter
= XCDR (alter
))
4836 if (STRINGP (XCAR (alter
)))
4838 family
= LSTRDUPA (XCAR (alter
));
4839 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
4843 /* Try font family of the default face or "fixed". */
4846 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4848 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
4851 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
4854 /* Try any family with the given registry. */
4856 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
4863 /* Return the registry and encoding pattern that fonts for CHARSET
4864 should match. Value is allocated from the heap. */
4867 x_charset_registry (charset
)
4870 Lisp_Object prop
, charset_plist
;
4873 /* Get registry and encoding from the charset's plist. */
4874 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
4875 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
4879 if (index (XSTRING (prop
)->data
, '-'))
4880 registry
= xstrdup (XSTRING (prop
)->data
);
4883 /* If registry doesn't contain a `-', make it a pattern. */
4884 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
4885 strcpy (registry
, XSTRING (prop
)->data
);
4886 strcat (registry
, "*-*");
4889 else if (STRINGP (Vface_default_registry
))
4890 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
4892 registry
= xstrdup ("iso8859-1");
4898 /* Return the fontset id of the fontset name or alias name given by
4899 the family attribute of ATTRS on frame F. Value is -1 if the
4900 family attribute of ATTRS doesn't name a fontset. */
4903 face_fontset (f
, attrs
)
4907 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
4910 name
= Fquery_fontset (name
, Qnil
);
4914 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
4920 /* Get the font to use for the face realizing the fully-specified Lisp
4921 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
4922 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
4923 in this case. Value is the font name which is allocated from the
4924 heap (which means that it must be freed eventually). */
4927 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
4931 Lisp_Object unibyte_registry
;
4933 struct font_name
*fonts
;
4937 /* ATTRS must be fully-specified. */
4938 xassert (lface_fully_specified_p (attrs
));
4940 if (STRINGP (unibyte_registry
))
4941 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
4943 registry
= x_charset_registry (charset
);
4945 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
4947 return best_matching_font (f
, attrs
, fonts
, nfonts
);
4951 /* Choose a font to use on frame F to display CHARSET using FONTSET
4952 with Lisp face attributes specified by ATTRS. CHARSET may be any
4953 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
4954 unibyte text. If the fontset doesn't contain a font pattern for
4955 charset, use the pattern for CHARSET_ASCII. Value is the font name
4956 which is allocated from the heap and must be freed by the caller. */
4959 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
4962 int fontset
, charset
;
4965 char *font_name
= NULL
;
4966 struct fontset_info
*fontset_info
;
4967 struct font_name
*fonts
;
4970 xassert (charset
!= CHARSET_COMPOSITION
);
4971 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
4973 /* For unibyte text, use the ASCII font of the fontset. Using the
4974 ASCII font seems to be the most reasonable thing we can do in
4977 charset
= CHARSET_ASCII
;
4979 /* Get the font name pattern to use for CHARSET from the fontset. */
4980 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
4981 pattern
= fontset_info
->fontname
[charset
];
4983 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
4986 /* Get a list of fonts matching that pattern and choose the
4987 best match for the specified face attributes from it. */
4988 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
4989 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
4993 #endif /* HAVE_X_WINDOWS */
4997 /***********************************************************************
4999 ***********************************************************************/
5001 /* Realize basic faces on frame F. Value is zero if frame parameters
5002 of F don't contain enough information needed to realize the default
5006 realize_basic_faces (f
)
5011 if (realize_default_face (f
))
5013 realize_named_face (f
, Qmodeline
, MODE_LINE_FACE_ID
);
5014 realize_named_face (f
, Qtoolbar
, TOOLBAR_FACE_ID
);
5015 realize_named_face (f
, Qbitmap_area
, BITMAP_AREA_FACE_ID
);
5016 realize_named_face (f
, Qtop_line
, TOP_LINE_FACE_ID
);
5024 /* Realize the default face on frame F. If the face is not fully
5025 specified, make it fully-specified. Attributes of the default face
5026 that are not explicitly specified are taken from frame parameters. */
5029 realize_default_face (f
)
5032 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5034 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5035 Lisp_Object unibyte_registry
;
5036 Lisp_Object frame_font
;
5040 /* If the `default' face is not yet known, create it. */
5041 lface
= lface_from_face_name (f
, Qdefault
, 0);
5045 XSETFRAME (frame
, f
);
5046 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5049 #ifdef HAVE_X_WINDOWS
5052 /* Set frame_font to the value of the `font' frame parameter. */
5053 frame_font
= Fassq (Qfont
, f
->param_alist
);
5054 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5055 frame_font
= XCDR (frame_font
);
5057 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5060 /* If frame_font is a fontset name, don't use that for
5061 determining font-related attributes of the default face
5062 because it is just an artificial name. Use the ASCII font of
5063 the fontset, instead. */
5064 struct font_info
*font_info
;
5065 struct font_name font
;
5068 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5072 /* Set weight etc. from the ASCII font. */
5073 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0))
5076 /* Remember registry and encoding of the frame font. */
5077 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5078 if (STRINGP (unibyte_registry
))
5079 Vface_default_registry
= unibyte_registry
;
5081 Vface_default_registry
= build_string ("iso8859-1");
5083 /* But set the family to the fontset alias name. Implementation
5084 note: When a font is passed to Emacs via `-fn FONT', a
5085 fontset is created in `x-win.el' whose name ends in
5086 `fontset-startup'. This fontset has an alias name that is
5087 equal to frame_font. */
5088 xassert (STRINGP (frame_font
));
5089 font
.name
= LSTRDUPA (frame_font
);
5091 if (!split_font_name (f
, &font
, 1)
5092 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5093 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5094 LFACE_FAMILY (lface
) = frame_font
;
5098 /* Frame parameters contain a real font. Fill default face
5099 attributes from that font. */
5100 if (!set_lface_from_font_name (f
, lface
,
5101 XSTRING (frame_font
)->data
, 0))
5104 /* Remember registry and encoding of the frame font. */
5106 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5107 if (STRINGP (unibyte_registry
))
5108 Vface_default_registry
= unibyte_registry
;
5110 Vface_default_registry
= build_string ("iso8859-1");
5113 #endif /* HAVE_X_WINDOWS */
5115 if (FRAME_TERMCAP_P (f
))
5117 LFACE_FAMILY (lface
) = build_string ("default");
5118 LFACE_SWIDTH (lface
) = Qnormal
;
5119 LFACE_HEIGHT (lface
) = make_number (1);
5120 LFACE_WEIGHT (lface
) = Qnormal
;
5121 LFACE_SLANT (lface
) = Qnormal
;
5124 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5125 LFACE_UNDERLINE (lface
) = Qnil
;
5127 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5128 LFACE_OVERLINE (lface
) = Qnil
;
5130 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5131 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5133 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5134 LFACE_BOX (lface
) = Qnil
;
5136 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5137 LFACE_INVERSE (lface
) = Qnil
;
5139 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5141 /* This function is called so early that colors are not yet
5142 set in the frame parameter list. */
5143 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5145 if (CONSP (color
) && STRINGP (XCDR (color
)))
5146 LFACE_FOREGROUND (lface
) = XCDR (color
);
5147 else if (FRAME_X_P (f
))
5149 else if (FRAME_TERMCAP_P (f
))
5150 /* Frame parameters for terminal frames usually don't contain
5151 a color. Use an empty string to indicate that the face
5152 should use the (unknown) default color of the terminal. */
5153 LFACE_FOREGROUND (lface
) = build_string ("");
5158 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5160 /* This function is called so early that colors are not yet
5161 set in the frame parameter list. */
5162 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5163 if (CONSP (color
) && STRINGP (XCDR (color
)))
5164 LFACE_BACKGROUND (lface
) = XCDR (color
);
5165 else if (FRAME_X_P (f
))
5167 else if (FRAME_TERMCAP_P (f
))
5168 /* Frame parameters for terminal frames usually don't contain
5169 a color. Use an empty string to indicate that the face
5170 should use the (unknown) default color of the terminal. */
5171 LFACE_BACKGROUND (lface
) = build_string ("");
5176 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5177 LFACE_STIPPLE (lface
) = Qnil
;
5179 /* Realize the face; it must be fully-specified now. */
5180 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5181 check_lface (lface
);
5182 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5183 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5185 /* Remove the former default face. */
5186 if (c
->used
> DEFAULT_FACE_ID
)
5188 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5189 uncache_face (c
, default_face
);
5190 free_realized_face (f
, default_face
);
5193 /* Insert the new default face. */
5194 cache_face (c
, face
, lface_hash (attrs
));
5195 xassert (face
->id
== DEFAULT_FACE_ID
);
5200 /* Realize basic faces other than the default face in face cache C.
5201 SYMBOL is the face name, ID is the face id the realized face must
5202 have. The default face must have been realized already. */
5205 realize_named_face (f
, symbol
, id
)
5210 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5211 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5212 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5213 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5214 struct face
*new_face
;
5216 /* The default face must exist and be fully specified. */
5217 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5218 check_lface_attrs (attrs
);
5219 xassert (lface_fully_specified_p (attrs
));
5221 /* If SYMBOL isn't know as a face, create it. */
5225 XSETFRAME (frame
, f
);
5226 lface
= Finternal_make_lisp_face (symbol
, frame
);
5229 /* Merge SYMBOL's face with the default face. */
5230 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5231 merge_face_vectors (symbol_attrs
, attrs
);
5233 /* Realize the face. */
5234 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5236 /* Remove the former face. */
5239 struct face
*old_face
= c
->faces_by_id
[id
];
5240 uncache_face (c
, old_face
);
5241 free_realized_face (f
, old_face
);
5244 /* Insert the new face. */
5245 cache_face (c
, new_face
, lface_hash (attrs
));
5246 xassert (new_face
->id
== id
);
5250 /* Realize the fully-specified face with attributes ATTRS in face
5251 cache C for character set CHARSET or for unibyte text if CHARSET <
5252 0. Value is a pointer to the newly created realized face. */
5254 static struct face
*
5255 realize_face (c
, attrs
, charset
)
5256 struct face_cache
*c
;
5262 /* LFACE must be fully specified. */
5263 xassert (c
!= NULL
);
5264 check_lface_attrs (attrs
);
5266 if (FRAME_X_P (c
->f
))
5267 face
= realize_x_face (c
, attrs
, charset
);
5268 else if (FRAME_TERMCAP_P (c
->f
))
5269 face
= realize_tty_face (c
, attrs
, charset
);
5277 /* Realize the fully-specified face with attributes ATTRS in face
5278 cache C for character set CHARSET or for unibyte text if CHARSET <
5279 0. Do it for X frame C->f. Value is a pointer to the newly
5280 created realized face. */
5282 static struct face
*
5283 realize_x_face (c
, attrs
, charset
)
5284 struct face_cache
*c
;
5288 #ifdef HAVE_X_WINDOWS
5289 struct face
*face
, *default_face
;
5290 struct frame
*f
= c
->f
;
5291 Lisp_Object stipple
, overline
, strike_through
, box
;
5292 Lisp_Object unibyte_registry
;
5293 struct gcpro gcpro1
;
5295 xassert (FRAME_X_P (f
));
5297 /* If realizing a face for use in unibyte text, get the X registry
5298 and encoding to use from Vface_default_registry. */
5300 unibyte_registry
= (STRINGP (Vface_default_registry
)
5301 ? Vface_default_registry
5302 : build_string ("iso8859-1"));
5304 unibyte_registry
= Qnil
;
5305 GCPRO1 (unibyte_registry
);
5307 /* Allocate a new realized face. */
5308 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5310 /* Determine the font to use. Most of the time, the font will be
5311 the same as the font of the default face, so try that first. */
5312 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5314 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5315 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5317 face
->font
= default_face
->font
;
5318 face
->fontset
= default_face
->fontset
;
5319 face
->font_info_id
= default_face
->font_info_id
;
5320 face
->font_name
= default_face
->font_name
;
5321 face
->registry
= default_face
->registry
;
5323 else if (charset
>= 0)
5325 /* For all charsets except CHARSET_COMPOSITION, we use our own
5326 font selection functions to choose a best matching font for
5327 the specified face attributes. If the face specifies a
5328 fontset alias name, the fontset determines the font name
5329 pattern, otherwise we construct a font pattern from face
5330 attributes and charset.
5332 If charset is CHARSET_COMPOSITION, we always construct a face
5333 with a fontset, even if the face doesn't specify a fontset alias
5334 (we use fontset-standard in that case). When the composite
5335 character is displayed in xterm.c, a suitable concrete font is
5336 loaded in x_get_char_font_and_encoding. */
5338 char *font_name
= NULL
;
5339 int fontset
= face_fontset (f
, attrs
);
5341 if (charset
== CHARSET_COMPOSITION
)
5342 fontset
= max (0, fontset
);
5343 else if (fontset
< 0)
5344 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5347 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5351 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5356 /* Unibyte case, and font is not equal to that of the default
5357 face. UNIBYTE_REGISTRY is the X registry and encoding the
5358 font should have. What is a reasonable thing to do if the
5359 user specified a fontset alias name for the face in this
5360 case? We choose a font by taking the ASCII font of the
5361 fontset, but using UNIBYTE_REGISTRY for its registry and
5364 char *font_name
= NULL
;
5365 int fontset
= face_fontset (f
, attrs
);
5368 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5370 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5372 load_face_font_or_fontset (f
, face
, font_name
, -1);
5376 /* Load colors, and set remaining attributes. */
5378 load_face_colors (f
, face
, attrs
);
5381 box
= attrs
[LFACE_BOX_INDEX
];
5384 /* A simple box of line width 1 drawn in color given by
5386 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5388 face
->box
= FACE_SIMPLE_BOX
;
5389 face
->box_line_width
= 1;
5391 else if (INTEGERP (box
))
5393 /* Simple box of specified line width in foreground color of the
5395 xassert (XINT (box
) > 0);
5396 face
->box
= FACE_SIMPLE_BOX
;
5397 face
->box_line_width
= XFASTINT (box
);
5398 face
->box_color
= face
->foreground
;
5399 face
->box_color_defaulted_p
= 1;
5401 else if (CONSP (box
))
5403 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5404 being one of `raised' or `sunken'. */
5405 face
->box
= FACE_SIMPLE_BOX
;
5406 face
->box_color
= face
->foreground
;
5407 face
->box_color_defaulted_p
= 1;
5408 face
->box_line_width
= 1;
5412 Lisp_Object keyword
, value
;
5414 keyword
= XCAR (box
);
5422 if (EQ (keyword
, QCline_width
))
5424 if (INTEGERP (value
) && XINT (value
) > 0)
5425 face
->box_line_width
= XFASTINT (value
);
5427 else if (EQ (keyword
, QCcolor
))
5429 if (STRINGP (value
))
5431 face
->box_color
= load_color (f
, face
, value
,
5433 face
->use_box_color_for_shadows_p
= 1;
5436 else if (EQ (keyword
, QCstyle
))
5438 if (EQ (value
, Qreleased_button
))
5439 face
->box
= FACE_RAISED_BOX
;
5440 else if (EQ (value
, Qpressed_button
))
5441 face
->box
= FACE_SUNKEN_BOX
;
5446 /* Text underline, overline, strike-through. */
5448 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5450 /* Use default color (same as foreground color). */
5451 face
->underline_p
= 1;
5452 face
->underline_defaulted_p
= 1;
5453 face
->underline_color
= 0;
5455 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5457 /* Use specified color. */
5458 face
->underline_p
= 1;
5459 face
->underline_defaulted_p
= 0;
5460 face
->underline_color
5461 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5462 LFACE_UNDERLINE_INDEX
);
5464 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5466 face
->underline_p
= 0;
5467 face
->underline_defaulted_p
= 0;
5468 face
->underline_color
= 0;
5471 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5472 if (STRINGP (overline
))
5474 face
->overline_color
5475 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5476 LFACE_OVERLINE_INDEX
);
5477 face
->overline_p
= 1;
5479 else if (EQ (overline
, Qt
))
5481 face
->overline_color
= face
->foreground
;
5482 face
->overline_color_defaulted_p
= 1;
5483 face
->overline_p
= 1;
5486 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5487 if (STRINGP (strike_through
))
5489 face
->strike_through_color
5490 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5491 LFACE_STRIKE_THROUGH_INDEX
);
5492 face
->strike_through_p
= 1;
5494 else if (EQ (strike_through
, Qt
))
5496 face
->strike_through_color
= face
->foreground
;
5497 face
->strike_through_color_defaulted_p
= 1;
5498 face
->strike_through_p
= 1;
5501 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5502 if (!NILP (stipple
))
5503 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5506 xassert (face
->fontset
< 0 || face
->charset
== CHARSET_COMPOSITION
);
5507 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
5509 #endif /* HAVE_X_WINDOWS */
5513 /* Realize the fully-specified face with attributes ATTRS in face
5514 cache C for character set CHARSET or for unibyte text if CHARSET <
5515 0. Do it for TTY frame C->f. Value is a pointer to the newly
5516 created realized face. */
5518 static struct face
*
5519 realize_tty_face (c
, attrs
, charset
)
5520 struct face_cache
*c
;
5528 /* Frame must be a termcap frame. */
5529 xassert (FRAME_TERMCAP_P (c
->f
));
5531 /* Allocate a new realized face. */
5532 face
= make_realized_face (attrs
, charset
, Qnil
);
5533 face
->font_name
= "tty";
5535 /* Map face attributes to TTY appearances. We map slant to
5536 dimmed text because we want italic text to appear differently
5537 and because dimmed text is probably used infrequently. */
5538 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5539 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5541 if (weight
> XLFD_WEIGHT_MEDIUM
)
5542 face
->tty_bold_p
= 1;
5543 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
5544 face
->tty_dim_p
= 1;
5545 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5546 face
->tty_underline_p
= 1;
5547 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5548 face
->tty_reverse_p
= 1;
5550 /* Map color names to color indices. */
5551 face
->foreground
= face
->background
= FACE_TTY_DEFAULT_COLOR
;
5553 color
= attrs
[LFACE_FOREGROUND_INDEX
];
5554 if (XSTRING (color
)->size
5555 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5557 face
->foreground
= XINT (XCDR (color
));
5559 color
= attrs
[LFACE_BACKGROUND_INDEX
];
5560 if (XSTRING (color
)->size
5561 && (color
= Fassoc (color
, Vface_tty_color_alist
),
5563 face
->background
= XINT (XCDR (color
));
5569 DEFUN ("face-register-tty-color", Fface_register_tty_color
,
5570 Sface_register_tty_color
, 2, 2, 0,
5571 "Say that COLOR is color number NUMBER on the terminal.\n\
5572 COLOR is a string, the color name. Value is COLOR.")
5574 Lisp_Object color
, number
;
5578 CHECK_STRING (color
, 0);
5579 CHECK_NUMBER (number
, 1);
5580 entry
= Fassoc (color
, Vface_tty_color_alist
);
5582 Vface_tty_color_alist
= Fcons (Fcons (color
, number
),
5583 Vface_tty_color_alist
);
5585 Fsetcdr (entry
, number
);
5590 DEFUN ("face-clear-tty-colors", Fface_clear_tty_colors
,
5591 Sface_clear_tty_colors
, 0, 0, 0,
5592 "Unregister all registered tty colors.")
5595 return Vface_tty_color_alist
= Qnil
;
5599 DEFUN ("tty-defined-colors", Ftty_defined_colors
,
5600 Stty_defined_colors
, 0, 0, 0,
5601 "Return a list of registered tty colors.")
5604 Lisp_Object list
, colors
;
5607 for (list
= Vface_tty_color_alist
; CONSP (list
); list
= XCDR (list
))
5608 colors
= Fcons (XCAR (XCAR (list
)), colors
);
5615 /***********************************************************************
5617 ***********************************************************************/
5619 /* Return the ID of the face to use to display character CH with face
5620 property PROP on frame F in current_buffer. */
5623 compute_char_face (f
, ch
, prop
)
5629 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
5631 : CHAR_CHARSET (ch
));
5634 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
5637 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5638 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5639 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5640 merge_face_vector_with_property (f
, attrs
, prop
);
5641 face_id
= lookup_face (f
, attrs
, charset
);
5648 /* Return the face ID associated with buffer position POS for
5649 displaying ASCII characters. Return in *ENDPTR the position at
5650 which a different face is needed, as far as text properties and
5651 overlays are concerned. W is a window displaying current_buffer.
5653 REGION_BEG, REGION_END delimit the region, so it can be
5656 LIMIT is a position not to scan beyond. That is to limit the time
5657 this function can take.
5659 If MOUSE is non-zero, use the character's mouse-face, not its face.
5661 The face returned is suitable for displaying CHARSET_ASCII if
5662 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
5663 the face is suitable for displaying unibyte text. */
5666 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
5667 endptr
, limit
, mouse
)
5670 int region_beg
, region_end
;
5675 struct frame
*f
= XFRAME (w
->frame
);
5676 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5677 Lisp_Object prop
, position
;
5679 Lisp_Object
*overlay_vec
;
5682 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5683 Lisp_Object limit1
, end
;
5684 struct face
*default_face
;
5685 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
5687 /* W must display the current buffer. We could write this function
5688 to use the frame and buffer of W, but right now it doesn't. */
5689 xassert (XBUFFER (w
->buffer
) == current_buffer
);
5691 XSETFRAME (frame
, f
);
5692 XSETFASTINT (position
, pos
);
5695 if (pos
< region_beg
&& region_beg
< endpos
)
5696 endpos
= region_beg
;
5698 /* Get the `face' or `mouse_face' text property at POS, and
5699 determine the next position at which the property changes. */
5700 prop
= Fget_text_property (position
, propname
, w
->buffer
);
5701 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5702 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
5704 endpos
= XINT (end
);
5706 /* Look at properties from overlays. */
5711 /* First try with room for 40 overlays. */
5713 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
5714 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
5715 &next_overlay
, NULL
);
5717 /* If there are more than 40, make enough space for all, and try
5719 if (noverlays
> len
)
5722 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
5723 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
5724 &next_overlay
, NULL
);
5727 if (next_overlay
< endpos
)
5728 endpos
= next_overlay
;
5733 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5735 /* Optimize common cases where we can use the default face. */
5738 && !(pos
>= region_beg
&& pos
< region_end
)
5740 || !FRAME_WINDOW_P (f
)
5741 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
5742 return DEFAULT_FACE_ID
;
5744 /* Begin with attributes from the default face. */
5745 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5747 /* Merge in attributes specified via text properties. */
5749 merge_face_vector_with_property (f
, attrs
, prop
);
5751 /* Now merge the overlay data. */
5752 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
5753 for (i
= 0; i
< noverlays
; i
++)
5758 prop
= Foverlay_get (overlay_vec
[i
], propname
);
5760 merge_face_vector_with_property (f
, attrs
, prop
);
5762 oend
= OVERLAY_END (overlay_vec
[i
]);
5763 oendpos
= OVERLAY_POSITION (oend
);
5764 if (oendpos
< endpos
)
5768 /* If in the region, merge in the region face. */
5769 if (pos
>= region_beg
&& pos
< region_end
)
5771 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
5772 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
5774 if (region_end
< endpos
)
5775 endpos
= region_end
;
5780 /* Look up a realized face with the given face attributes,
5781 or realize a new one. Charset is ignored for tty frames. */
5782 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
5786 /* Compute the face at character position POS in Lisp string STRING on
5787 window W, for charset CHARSET_ASCII.
5789 If STRING is an overlay string, it comes from position BUFPOS in
5790 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
5791 not an overlay string. W must display the current buffer.
5792 REGION_BEG and REGION_END give the start and end positions of the
5793 region; both are -1 if no region is visible. BASE_FACE_ID is the
5794 id of the basic face to merge with. It is usually equal to
5795 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or TOP_LINE_FACE_ID
5796 for strings displayed in the mode or top line.
5798 Set *ENDPTR to the next position where to check for faces in
5799 STRING; -1 if the face is constant from POS to the end of the
5802 Value is the id of the face to use. The face returned is suitable
5803 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
5804 the face is suitable for displaying unibyte text. */
5807 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
5808 region_end
, endptr
, base_face_id
)
5812 int region_beg
, region_end
;
5814 enum face_id base_face_id
;
5816 Lisp_Object prop
, position
, end
, limit
;
5817 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
5818 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5819 struct face
*base_face
;
5820 int multibyte_p
= STRING_MULTIBYTE (string
);
5822 /* Get the value of the face property at the current position within
5823 STRING. Value is nil if there is no face property. */
5824 XSETFASTINT (position
, pos
);
5825 prop
= Fget_text_property (position
, Qface
, string
);
5827 /* Get the next position at which to check for faces. Value of end
5828 is nil if face is constant all the way to the end of the string.
5829 Otherwise it is a string position where to check faces next.
5830 Limit is the maximum position up to which to check for property
5831 changes in Fnext_single_property_change. Strings are usually
5832 short, so set the limit to the end of the string. */
5833 XSETFASTINT (limit
, XSTRING (string
)->size
);
5834 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
5836 *endptr
= XFASTINT (end
);
5840 base_face
= FACE_FROM_ID (f
, base_face_id
);
5841 xassert (base_face
);
5843 /* Optimize the default case that there is no face property and we
5844 are not in the region. */
5846 && (base_face_id
!= DEFAULT_FACE_ID
5847 /* BUFPOS <= 0 means STRING is not an overlay string, so
5848 that the region doesn't have to be taken into account. */
5850 || bufpos
< region_beg
5851 || bufpos
>= region_end
)
5853 /* We can't realize faces for different charsets differently
5854 if we don't have fonts, so we can stop here if not working
5855 on a window-system frame. */
5856 || !FRAME_WINDOW_P (f
)
5857 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
5858 return base_face
->id
;
5860 /* Begin with attributes from the base face. */
5861 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
5863 /* Merge in attributes specified via text properties. */
5865 merge_face_vector_with_property (f
, attrs
, prop
);
5867 /* If in the region, merge in the region face. */
5869 && bufpos
>= region_beg
5870 && bufpos
< region_end
)
5872 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
5873 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
5876 /* Look up a realized face with the given face attributes,
5877 or realize a new one. */
5878 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
5883 /***********************************************************************
5885 ***********************************************************************/
5889 /* Print the contents of the realized face FACE to stderr. */
5892 dump_realized_face (face
)
5895 fprintf (stderr
, "ID: %d\n", face
->id
);
5896 #ifdef HAVE_X_WINDOWS
5897 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
5899 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
5901 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
5902 fprintf (stderr
, "background: 0x%lx (%s)\n",
5904 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
5905 fprintf (stderr
, "font_name: %s (%s)\n",
5907 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
5908 #ifdef HAVE_X_WINDOWS
5909 fprintf (stderr
, "font = %p\n", face
->font
);
5911 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
5912 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
5913 fprintf (stderr
, "underline: %d (%s)\n",
5915 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
5916 fprintf (stderr
, "hash: %d\n", face
->hash
);
5917 fprintf (stderr
, "charset: %d\n", face
->charset
);
5921 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
5929 fprintf (stderr
, "font selection order: ");
5930 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5931 fprintf (stderr
, "%d ", font_sort_order
[i
]);
5932 fprintf (stderr
, "\n");
5934 fprintf (stderr
, "alternative fonts: ");
5935 debug_print (Vface_alternative_font_family_alist
);
5936 fprintf (stderr
, "\n");
5938 for (i
= 0; i
< FRAME_FACE_CACHE (selected_frame
)->used
; ++i
)
5939 Fdump_face (make_number (i
));
5944 CHECK_NUMBER (n
, 0);
5945 face
= FACE_FROM_ID (selected_frame
, XINT (n
));
5947 error ("Not a valid face");
5948 dump_realized_face (face
);
5955 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
5959 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
5960 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
5961 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
5965 #endif /* GLYPH_DEBUG != 0 */
5969 /***********************************************************************
5971 ***********************************************************************/
5976 Qface
= intern ("face");
5978 Qpixmap_spec_p
= intern ("pixmap-spec-p");
5979 staticpro (&Qpixmap_spec_p
);
5981 /* Lisp face attribute keywords. */
5982 QCfamily
= intern (":family");
5983 staticpro (&QCfamily
);
5984 QCheight
= intern (":height");
5985 staticpro (&QCheight
);
5986 QCweight
= intern (":weight");
5987 staticpro (&QCweight
);
5988 QCslant
= intern (":slant");
5989 staticpro (&QCslant
);
5990 QCunderline
= intern (":underline");
5991 staticpro (&QCunderline
);
5992 QCinverse_video
= intern (":inverse-video");
5993 staticpro (&QCinverse_video
);
5994 QCreverse_video
= intern (":reverse-video");
5995 staticpro (&QCreverse_video
);
5996 QCforeground
= intern (":foreground");
5997 staticpro (&QCforeground
);
5998 QCbackground
= intern (":background");
5999 staticpro (&QCbackground
);
6000 QCstipple
= intern (":stipple");;
6001 staticpro (&QCstipple
);
6002 QCwidth
= intern (":width");
6003 staticpro (&QCwidth
);
6004 QCfont
= intern (":font");
6005 staticpro (&QCfont
);
6006 QCbold
= intern (":bold");
6007 staticpro (&QCbold
);
6008 QCitalic
= intern (":italic");
6009 staticpro (&QCitalic
);
6010 QCoverline
= intern (":overline");
6011 staticpro (&QCoverline
);
6012 QCstrike_through
= intern (":strike-through");
6013 staticpro (&QCstrike_through
);
6014 QCbox
= intern (":box");
6017 /* Symbols used for Lisp face attribute values. */
6018 QCcolor
= intern (":color");
6019 staticpro (&QCcolor
);
6020 QCline_width
= intern (":line-width");
6021 staticpro (&QCline_width
);
6022 QCstyle
= intern (":style");
6023 staticpro (&QCstyle
);
6024 Qreleased_button
= intern ("released-button");
6025 staticpro (&Qreleased_button
);
6026 Qpressed_button
= intern ("pressed-button");
6027 staticpro (&Qpressed_button
);
6028 Qnormal
= intern ("normal");
6029 staticpro (&Qnormal
);
6030 Qultra_light
= intern ("ultra-light");
6031 staticpro (&Qultra_light
);
6032 Qextra_light
= intern ("extra-light");
6033 staticpro (&Qextra_light
);
6034 Qlight
= intern ("light");
6035 staticpro (&Qlight
);
6036 Qsemi_light
= intern ("semi-light");
6037 staticpro (&Qsemi_light
);
6038 Qsemi_bold
= intern ("semi-bold");
6039 staticpro (&Qsemi_bold
);
6040 Qbold
= intern ("bold");
6042 Qextra_bold
= intern ("extra-bold");
6043 staticpro (&Qextra_bold
);
6044 Qultra_bold
= intern ("ultra-bold");
6045 staticpro (&Qultra_bold
);
6046 Qoblique
= intern ("oblique");
6047 staticpro (&Qoblique
);
6048 Qitalic
= intern ("italic");
6049 staticpro (&Qitalic
);
6050 Qreverse_oblique
= intern ("reverse-oblique");
6051 staticpro (&Qreverse_oblique
);
6052 Qreverse_italic
= intern ("reverse-italic");
6053 staticpro (&Qreverse_italic
);
6054 Qultra_condensed
= intern ("ultra-condensed");
6055 staticpro (&Qultra_condensed
);
6056 Qextra_condensed
= intern ("extra-condensed");
6057 staticpro (&Qextra_condensed
);
6058 Qcondensed
= intern ("condensed");
6059 staticpro (&Qcondensed
);
6060 Qsemi_condensed
= intern ("semi-condensed");
6061 staticpro (&Qsemi_condensed
);
6062 Qsemi_expanded
= intern ("semi-expanded");
6063 staticpro (&Qsemi_expanded
);
6064 Qexpanded
= intern ("expanded");
6065 staticpro (&Qexpanded
);
6066 Qextra_expanded
= intern ("extra-expanded");
6067 staticpro (&Qextra_expanded
);
6068 Qultra_expanded
= intern ("ultra-expanded");
6069 staticpro (&Qultra_expanded
);
6070 Qbackground_color
= intern ("background-color");
6071 staticpro (&Qbackground_color
);
6072 Qforeground_color
= intern ("foreground-color");
6073 staticpro (&Qforeground_color
);
6074 Qunspecified
= intern ("unspecified");
6075 staticpro (&Qunspecified
);
6077 Qx_charset_registry
= intern ("x-charset-registry");
6078 staticpro (&Qx_charset_registry
);
6079 Qdefault
= intern ("default");
6080 staticpro (&Qdefault
);
6081 Qmodeline
= intern ("modeline");
6082 staticpro (&Qmodeline
);
6083 Qtoolbar
= intern ("toolbar");
6084 staticpro (&Qtoolbar
);
6085 Qregion
= intern ("region");
6086 staticpro (&Qregion
);
6087 Qbitmap_area
= intern ("bitmap-area");
6088 staticpro (&Qbitmap_area
);
6089 Qtop_line
= intern ("top-line");
6090 staticpro (&Qtop_line
);
6092 defsubr (&Sinternal_make_lisp_face
);
6093 defsubr (&Sinternal_lisp_face_p
);
6094 defsubr (&Sinternal_set_lisp_face_attribute
);
6095 #ifdef HAVE_X_WINDOWS
6096 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6097 defsubr (&Sface_color_gray_p
);
6098 defsubr (&Sface_color_supported_p
);
6100 defsubr (&Sinternal_get_lisp_face_attribute
);
6101 defsubr (&Sinternal_lisp_face_attribute_values
);
6102 defsubr (&Sinternal_lisp_face_equal_p
);
6103 defsubr (&Sinternal_lisp_face_empty_p
);
6104 defsubr (&Sinternal_copy_lisp_face
);
6105 defsubr (&Sinternal_merge_in_global_face
);
6106 defsubr (&Sface_font
);
6107 defsubr (&Sframe_face_alist
);
6108 defsubr (&Sinternal_set_font_selection_order
);
6109 defsubr (&Sinternal_set_alternative_font_family_alist
);
6111 defsubr (&Sdump_face
);
6112 defsubr (&Sshow_face_resources
);
6113 #endif /* GLYPH_DEBUG */
6114 defsubr (&Sclear_face_cache
);
6116 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6117 "List of global face definitions (for internal use only.)");
6118 Vface_new_frame_defaults
= Qnil
;
6120 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6121 "*Default stipple pattern used on monochrome displays.\n\
6122 This stipple pattern is used on monochrome displays\n\
6123 instead of shades of gray for a face background color.\n\
6124 See `set-face-stipple' for possible values for this variable.");
6125 Vface_default_stipple
= build_string ("gray3");
6127 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6128 "Default registry and encoding to use.\n\
6129 This registry and encoding is used for unibyte text. It is set up\n\
6130 from the specified frame font when Emacs starts. (For internal use only.)");
6131 Vface_default_registry
= Qnil
;
6133 DEFVAR_LISP ("face-alternative-font-family-alist",
6134 &Vface_alternative_font_family_alist
, "");
6135 Vface_alternative_font_family_alist
= Qnil
;
6139 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6140 "Allowed scalable fonts.\n\
6141 A value of nil means don't allow any scalable fonts.\n\
6142 A value of t means allow any scalable font.\n\
6143 Otherwise, value must be a list of regular expressions. A font may be\n\
6144 scaled if its name matches a regular expression in the list.");
6145 Vscalable_fonts_allowed
= Qnil
;
6147 #endif /* SCALABLE_FONTS */
6149 #ifdef HAVE_X_WINDOWS
6150 defsubr (&Spixmap_spec_p
);
6151 defsubr (&Sx_list_fonts
);
6152 defsubr (&Sinternal_face_x_get_resource
);
6153 defsubr (&Sx_font_list
);
6154 defsubr (&Sx_font_family_list
);
6155 #endif /* HAVE_X_WINDOWS */
6157 /* TTY face support. */
6158 defsubr (&Sface_register_tty_color
);
6159 defsubr (&Sface_clear_tty_colors
);
6160 defsubr (&Stty_defined_colors
);
6161 Vface_tty_color_alist
= Qnil
;
6162 staticpro (&Vface_tty_color_alist
);