1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
25 When using Emacs with X, the display style of characters can be
26 changed by defining `faces'. Each face can specify the following
29 1. Font family or fontset alias name.
31 2. Relative proportionate width, aka character set width or set
32 width (swidth), e.g. `semi-compressed'.
34 3. Font height in 1/10pt
36 4. Font weight, e.g. `bold'.
38 5. Font slant, e.g. `italic'.
44 8. Whether or not characters should be underlined, and in what color.
46 9. Whether or not characters should be displayed in inverse video.
48 10. A background stipple, a bitmap.
50 11. Whether or not characters should be overlined, and in what color.
52 12. Whether or not characters should be strike-through, and in what
55 13. Whether or not a box should be drawn around characters, the box
56 type, and, for simple boxes, in what color.
58 Faces are frame-local by nature because Emacs allows to define the
59 same named face (face names are symbols) differently for different
60 frames. Each frame has an alist of face definitions for all named
61 faces. The value of a named face in such an alist is a Lisp vector
62 with the symbol `face' in slot 0, and a slot for each each of the
63 face attributes mentioned above.
65 There is also a global face alist `Vface_new_frame_defaults'. Face
66 definitions from this list are used to initialize faces of newly
69 A face doesn't have to specify all attributes. Those not specified
70 have a value of `unspecified'. Faces specifying all attributes are
71 called `fully-specified'.
76 The display style of a given character in the text is determined by
77 combining several faces. This process is called `face merging'.
78 Any aspect of the display style that isn't specified by overlays or
79 text properties is taken from the `default' face. Since it is made
80 sure that the default face is always fully-specified, face merging
81 always results in a fully-specified face.
86 After all face attributes for a character have been determined by
87 merging faces of that character, that face is `realized'. The
88 realization process maps face attributes to what is physically
89 available on the system where Emacs runs. The result is a
90 `realized face' in form of a struct face which is stored in the
91 face cache of the frame on which it was realized.
93 Face realization is done in the context of the charset of the
94 character to display because different fonts and encodings are used
95 for different charsets. In other words, for characters of
96 different charsets, different realized faces are needed to display
99 Except for composite characters (CHARSET_COMPOSITION), faces are
100 always realized for a specific character set and contain a specific
101 font, even if the face being realized specifies a fontset (see
102 `font selection' below). The reason is that the result of the new
103 font selection stage is better than what can be done with
104 statically defined font name patterns in fontsets.
109 In unibyte text, Emacs' charsets aren't applicable; function
110 `char-charset' reports CHARSET_ASCII for all characters, including
111 those > 0x7f. The X registry and encoding of fonts to use is
112 determined from the variable `x-unibyte-registry-and-encoding' in
113 this case. The variable is initialized at Emacs startup time from
114 the font the user specified for Emacs.
116 Currently all unibyte text, i.e. all buffers with
117 enable_multibyte_characters nil are displayed with fonts of the
118 same registry and encoding `x-unibyte-registry-and-encoding'. This
119 is consistent with the fact that languages can also be set
125 Font selection tries to find the best available matching font for a
126 given (charset, face) combination. This is done slightly
127 differently for faces specifying a fontset, or a font family name.
129 If the face specifies a fontset alias name, that fontset determines
130 a pattern for fonts of the given charset. If the face specifies a
131 font family, a font pattern is constructed. Charset symbols have a
132 property `x-charset-registry' for that purpose that maps a charset
133 to an XLFD registry and encoding in the font pattern constructed.
135 Available fonts on the system on which Emacs runs are then matched
136 against the font pattern. The result of font selection is the best
137 match for the given face attributes in this font list.
139 Font selection can be influenced by the user.
141 1. The user can specify the relative importance he gives the face
142 attributes width, height, weight, and slant by setting
143 face-font-selection-order (faces.el) to a list of face attribute
144 names. The default is '(:width :height :weight :slant), and means
145 that font selection first tries to find a good match for the font
146 width specified by a face, then---within fonts with that
147 width---tries to find a best match for the specified font height,
150 2. Setting face-alternative-font-family-alist allows the user to
151 specify alternative font families to try if a family specified by a
155 Composite characters.
157 Realized faces for composite characters are the only ones having a
158 fontset id >= 0. When a composite character is encoded into a
159 sequence of non-composite characters (in xterm.c), a suitable font
160 for the non-composite characters is then selected and realized,
161 i.e. the realization process is delayed but in principle the same.
164 Initialization of basic faces.
166 The faces `default', `modeline' are considered `basic faces'.
167 When redisplay happens the first time for a newly created frame,
168 basic faces are realized for CHARSET_ASCII. Frame parameters are
169 used to fill in unspecified attributes of the default face. */
171 /* Define SCALABLE_FONTS to a non-zero value to enable scalable
172 font use. Define it to zero to disable scalable font use.
174 Use of too many or too large scalable fonts can crash XFree86
175 servers. That's why I've put the code dealing with scalable fonts
178 #define SCALABLE_FONTS 1
181 #include <sys/types.h>
182 #include <sys/stat.h>
187 #ifdef HAVE_X_WINDOWS
192 #include <Xm/XmStrDefs.h>
193 #endif /* USE_MOTIF */
201 #include "dispextern.h"
202 #include "blockinput.h"
204 #include "intervals.h"
206 #ifdef HAVE_X_WINDOWS
208 /* Compensate for a bug in Xos.h on some systems, on which it requires
209 time.h. On some such systems, Xos.h tries to redefine struct
210 timeval and struct timezone if USG is #defined while it is
213 #ifdef XOS_NEEDS_TIME_H
219 #else /* not XOS_NEEDS_TIME_H */
221 #endif /* not XOS_NEEDS_TIME_H */
223 #endif /* HAVE_X_WINDOWS */
227 #include "keyboard.h"
230 #define max(A, B) ((A) > (B) ? (A) : (B))
231 #define min(A, B) ((A) < (B) ? (A) : (B))
232 #define abs(X) ((X) < 0 ? -(X) : (X))
235 /* Non-zero if face attribute ATTR is unspecified. */
237 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
239 /* Value is the number of elements of VECTOR. */
241 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
243 /* Make a copy of string S on the stack using alloca. Value is a pointer
246 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
248 /* Make a copy of the contents of Lisp string S on the stack using
249 alloca. Value is a pointer to the copy. */
251 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
253 /* Size of hash table of realized faces in face caches (should be a
256 #define FACE_CACHE_BUCKETS_SIZE 1001
258 /* A definition of XColor for non-X frames. */
259 #ifndef HAVE_X_WINDOWS
262 unsigned short red
, green
, blue
;
268 /* Keyword symbols used for face attribute names. */
270 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
271 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
272 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
273 Lisp_Object QCreverse_video
;
274 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
276 /* Symbols used for attribute values. */
278 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
279 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
280 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
281 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
282 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
283 Lisp_Object Qultra_expanded
;
284 Lisp_Object Qreleased_button
, Qpressed_button
;
285 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
286 Lisp_Object Qunspecified
;
288 /* The symbol `x-charset-registry'. This property of charsets defines
289 the X registry and encoding that fonts should have that are used to
290 display characters of that charset. */
292 Lisp_Object Qx_charset_registry
;
294 /* The name of the function to call when the background of the frame
295 has changed, frame_update_face_colors. */
297 Lisp_Object Qframe_update_face_colors
;
299 /* Names of basic faces. */
301 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
302 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
303 extern Lisp_Object Qmode_line
;
305 /* The symbol `face-alias'. A symbols having that property is an
306 alias for another face. Value of the property is the name of
309 Lisp_Object Qface_alias
;
311 /* Names of frame parameters related to faces. */
313 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
314 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
316 /* Default stipple pattern used on monochrome displays. This stipple
317 pattern is used on monochrome displays instead of shades of gray
318 for a face background color. See `set-face-stipple' for possible
319 values for this variable. */
321 Lisp_Object Vface_default_stipple
;
323 /* Default registry and encoding to use for charsets whose charset
324 symbols don't specify one. */
326 Lisp_Object Vface_default_registry
;
328 /* Alist of alternative font families. Each element is of the form
329 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
330 try FAMILY1, then FAMILY2, ... */
332 Lisp_Object Vface_alternative_font_family_alist
;
334 /* Allowed scalable fonts. A value of nil means don't allow any
335 scalable fonts. A value of t means allow the use of any scalable
336 font. Otherwise, value must be a list of regular expressions. A
337 font may be scaled if its name matches a regular expression in the
341 Lisp_Object Vscalable_fonts_allowed
;
344 /* Maximum number of fonts to consider in font_list. If not an
345 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
347 Lisp_Object Vfont_list_limit
;
348 #define DEFAULT_FONT_LIST_LIMIT 100
350 /* The symbols `foreground-color' and `background-color' which can be
351 used as part of a `face' property. This is for compatibility with
354 Lisp_Object Qforeground_color
, Qbackground_color
;
356 /* The symbols `face' and `mouse-face' used as text properties. */
359 extern Lisp_Object Qmouse_face
;
361 /* Error symbol for wrong_type_argument in load_pixmap. */
363 Lisp_Object Qbitmap_spec_p
;
365 /* Alist of global face definitions. Each element is of the form
366 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
367 is a Lisp vector of face attributes. These faces are used
368 to initialize faces for new frames. */
370 Lisp_Object Vface_new_frame_defaults
;
372 /* The next ID to assign to Lisp faces. */
374 static int next_lface_id
;
376 /* A vector mapping Lisp face Id's to face names. */
378 static Lisp_Object
*lface_id_to_name
;
379 static int lface_id_to_name_size
;
381 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
382 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
384 /* Counter for calls to clear_face_cache. If this counter reaches
385 CLEAR_FONT_TABLE_COUNT, and a frame has more than
386 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
388 static int clear_font_table_count
;
389 #define CLEAR_FONT_TABLE_COUNT 100
390 #define CLEAR_FONT_TABLE_NFONTS 10
392 /* Non-zero means face attributes have been changed since the last
393 redisplay. Used in redisplay_internal. */
395 int face_change_count
;
397 /* The total number of colors currently allocated. */
400 static int ncolors_allocated
;
401 static int npixmaps_allocated
;
407 /* Function prototypes. */
412 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
413 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
414 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
415 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
417 static int first_font_matching
P_ ((struct frame
*f
, char *,
418 struct font_name
*));
419 static int x_face_list_fonts
P_ ((struct frame
*, char *,
420 struct font_name
*, int, int, int));
421 static int font_scalable_p
P_ ((struct font_name
*));
422 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
423 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
424 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
425 static char *xstrdup
P_ ((char *));
426 static unsigned char *xstrlwr
P_ ((unsigned char *));
427 static void signal_error
P_ ((char *, Lisp_Object
));
428 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
429 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
430 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
431 static void free_face_colors
P_ ((struct frame
*, struct face
*));
432 static int face_color_gray_p
P_ ((struct frame
*, char *));
433 static char *build_font_name
P_ ((struct font_name
*));
434 static void free_font_names
P_ ((struct font_name
*, int));
435 static int sorted_font_list
P_ ((struct frame
*, char *,
436 int (*cmpfn
) P_ ((const void *, const void *)),
437 struct font_name
**));
438 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
439 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
440 struct font_name
**));
441 static int cmp_font_names
P_ ((const void *, const void *));
442 static struct face
*realize_face
P_ ((struct face_cache
*,
443 Lisp_Object
*, int));
444 static struct face
*realize_x_face
P_ ((struct face_cache
*,
445 Lisp_Object
*, int));
446 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
447 Lisp_Object
*, int));
448 static int realize_basic_faces
P_ ((struct frame
*));
449 static int realize_default_face
P_ ((struct frame
*));
450 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
451 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
452 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
453 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
454 static unsigned lface_hash
P_ ((Lisp_Object
*));
455 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
456 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
457 static void free_realized_face
P_ ((struct frame
*, struct face
*));
458 static void clear_face_gcs
P_ ((struct face_cache
*));
459 static void free_face_cache
P_ ((struct face_cache
*));
460 static int face_numeric_weight
P_ ((Lisp_Object
));
461 static int face_numeric_slant
P_ ((Lisp_Object
));
462 static int face_numeric_swidth
P_ ((Lisp_Object
));
463 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
464 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
466 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
468 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
469 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
471 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
473 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
474 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
475 static void free_realized_faces
P_ ((struct face_cache
*));
476 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
477 struct font_name
*, int));
478 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
479 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
480 static int xlfd_numeric_slant
P_ ((struct font_name
*));
481 static int xlfd_numeric_weight
P_ ((struct font_name
*));
482 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
483 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
484 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
485 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
486 static int xlfd_fixed_p
P_ ((struct font_name
*));
487 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
489 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
490 struct font_name
*, int, int));
491 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
492 struct font_name
*, int));
494 #ifdef HAVE_X_WINDOWS
496 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
497 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
498 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
499 int (*cmpfn
) P_ ((const void *, const void *))));
500 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
501 static void x_free_gc
P_ ((struct frame
*, GC
));
502 static void clear_font_table
P_ ((struct frame
*));
504 #endif /* HAVE_X_WINDOWS */
507 /***********************************************************************
509 ***********************************************************************/
511 #ifdef HAVE_X_WINDOWS
513 /* Create and return a GC for use on frame F. GC values and mask
514 are given by XGCV and MASK. */
517 x_create_gc (f
, mask
, xgcv
)
524 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
531 /* Free GC which was used on frame F. */
539 xassert (--ngcs
>= 0);
540 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
544 #endif /* HAVE_X_WINDOWS */
547 /* Like strdup, but uses xmalloc. */
553 int len
= strlen (s
) + 1;
554 char *p
= (char *) xmalloc (len
);
560 /* Like stricmp. Used to compare parts of font names which are in
565 unsigned char *s1
, *s2
;
569 unsigned char c1
= tolower (*s1
);
570 unsigned char c2
= tolower (*s2
);
572 return c1
< c2
? -1 : 1;
577 return *s2
== 0 ? 0 : -1;
582 /* Like strlwr, which might not always be available. */
584 static unsigned char *
588 unsigned char *p
= s
;
597 /* Signal `error' with message S, and additional argument ARG. */
600 signal_error (s
, arg
)
604 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
608 /* If FRAME is nil, return a pointer to the selected frame.
609 Otherwise, check that FRAME is a live frame, and return a pointer
610 to it. NPARAM is the parameter number of FRAME, for
611 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
612 Lisp function definitions. */
614 static INLINE
struct frame
*
615 frame_or_selected_frame (frame
, nparam
)
620 frame
= selected_frame
;
622 CHECK_LIVE_FRAME (frame
, nparam
);
623 return XFRAME (frame
);
627 /***********************************************************************
629 ***********************************************************************/
631 /* Initialize face cache and basic faces for frame F. */
637 /* Make a face cache, if F doesn't have one. */
638 if (FRAME_FACE_CACHE (f
) == NULL
)
639 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
641 #ifdef HAVE_X_WINDOWS
642 /* Make the image cache. */
645 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
646 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
647 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
649 #endif /* HAVE_X_WINDOWS */
651 /* Realize basic faces. Must have enough information in frame
652 parameters to realize basic faces at this point. */
653 #ifdef HAVE_X_WINDOWS
654 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
656 if (!realize_basic_faces (f
))
661 /* Free face cache of frame F. Called from Fdelete_frame. */
667 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
671 free_face_cache (face_cache
);
672 FRAME_FACE_CACHE (f
) = NULL
;
675 #ifdef HAVE_X_WINDOWS
678 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
681 --image_cache
->refcount
;
682 if (image_cache
->refcount
== 0)
683 free_image_cache (f
);
686 #endif /* HAVE_X_WINDOWS */
690 /* Clear face caches, and recompute basic faces for frame F. Call
691 this after changing frame parameters on which those faces depend,
692 or when realized faces have been freed due to changing attributes
696 recompute_basic_faces (f
)
699 if (FRAME_FACE_CACHE (f
))
701 clear_face_cache (0);
702 if (!realize_basic_faces (f
))
708 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
709 try to free unused fonts, too. */
712 clear_face_cache (clear_fonts_p
)
715 #ifdef HAVE_X_WINDOWS
716 Lisp_Object tail
, frame
;
720 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
722 /* From time to time see if we can unload some fonts. This also
723 frees all realized faces on all frames. Fonts needed by
724 faces will be loaded again when faces are realized again. */
725 clear_font_table_count
= 0;
727 FOR_EACH_FRAME (tail
, frame
)
731 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
733 free_all_realized_faces (frame
);
734 clear_font_table (f
);
740 /* Clear GCs of realized faces. */
741 FOR_EACH_FRAME (tail
, frame
)
746 clear_face_gcs (FRAME_FACE_CACHE (f
));
747 clear_image_cache (f
, 0);
751 #endif /* HAVE_X_WINDOWS */
755 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
756 "Clear face caches on all frames.\n\
757 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
759 Lisp_Object thorougly
;
761 clear_face_cache (!NILP (thorougly
));
767 #ifdef HAVE_X_WINDOWS
770 /* Remove those fonts from the font table of frame F that are not used
771 by fontsets. Called from clear_face_cache from time to time. */
777 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
779 Lisp_Object rest
, frame
;
782 xassert (FRAME_X_P (f
));
784 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
785 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
787 /* For all frames with the same x_display_info as F, record
788 in `used' those fonts that are in use by fontsets. */
789 FOR_EACH_FRAME (rest
, frame
)
790 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
792 struct frame
*f
= XFRAME (frame
);
793 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
795 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
797 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
800 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
802 int idx
= info
->font_indexes
[j
];
809 /* Free those fonts that are not used by fontsets. */
810 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
811 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
813 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
815 /* Free names. In xfns.c there is a comment that full_name
816 should never be freed because it is always shared with
817 something else. I don't think this is true anymore---see
818 x_load_font. It's either equal to font_info->name or
819 allocated via xmalloc, and there seems to be no place in
820 the source files where full_name is transferred to another
822 if (font_info
->full_name
!= font_info
->name
)
823 xfree (font_info
->full_name
);
824 xfree (font_info
->name
);
828 XFreeFont (dpyinfo
->display
, font_info
->font
);
831 /* Mark font table slot free. */
832 font_info
->font
= NULL
;
833 font_info
->name
= font_info
->full_name
= NULL
;
838 #endif /* HAVE_X_WINDOWS */
842 /***********************************************************************
844 ***********************************************************************/
846 #ifdef HAVE_X_WINDOWS
848 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
849 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
850 A bitmap specification is either a string, a file name, or a list\n\
851 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
852 HEIGHT is its height, and DATA is a string containing the bits of\n\
853 the pixmap. Bits are stored row by row, each row occupies\n\
854 (WIDTH + 7)/8 bytes.")
860 if (STRINGP (object
))
861 /* If OBJECT is a string, it's a file name. */
863 else if (CONSP (object
))
865 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
866 HEIGHT must be integers > 0, and DATA must be string large
867 enough to hold a bitmap of the specified size. */
868 Lisp_Object width
, height
, data
;
870 height
= width
= data
= Qnil
;
874 width
= XCAR (object
);
875 object
= XCDR (object
);
878 height
= XCAR (object
);
879 object
= XCDR (object
);
881 data
= XCAR (object
);
885 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
887 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
889 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
894 return pixmap_p
? Qt
: Qnil
;
898 /* Load a bitmap according to NAME (which is either a file name or a
899 pixmap spec) for use on frame F. Value is the bitmap_id (see
900 xfns.c). If NAME is nil, return with a bitmap id of zero. If
901 bitmap cannot be loaded, display a message saying so, and return
902 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
903 if these pointers are not null. */
906 load_pixmap (f
, name
, w_ptr
, h_ptr
)
909 unsigned int *w_ptr
, *h_ptr
;
917 tem
= Fbitmap_spec_p (name
);
919 wrong_type_argument (Qbitmap_spec_p
, name
);
924 /* Decode a bitmap spec into a bitmap. */
929 w
= XINT (Fcar (name
));
930 h
= XINT (Fcar (Fcdr (name
)));
931 bits
= Fcar (Fcdr (Fcdr (name
)));
933 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
938 /* It must be a string -- a file name. */
939 bitmap_id
= x_create_bitmap_from_file (f
, name
);
945 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
956 ++npixmaps_allocated
;
959 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
962 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
968 #endif /* HAVE_X_WINDOWS */
972 /***********************************************************************
974 ***********************************************************************/
976 #ifdef HAVE_X_WINDOWS
978 /* Update the line_height of frame F. Return non-zero if line height
982 frame_update_line_height (f
)
985 int fontset
, line_height
, changed_p
;
987 fontset
= f
->output_data
.x
->fontset
;
989 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
991 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
993 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
994 f
->output_data
.x
->line_height
= line_height
;
998 #endif /* HAVE_X_WINDOWS */
1001 /***********************************************************************
1003 ***********************************************************************/
1005 #ifdef HAVE_X_WINDOWS
1007 /* Load font or fontset of face FACE which is used on frame F.
1008 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1009 fontset. FONT_NAME is the name of the font to load, if no fontset
1010 is used. It is null if no suitable font name could be determined
1014 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1020 struct font_info
*font_info
= NULL
;
1022 face
->font_info_id
= -1;
1023 face
->fontset
= fontset
;
1028 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1031 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1040 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1041 face
->font
= font_info
->font
;
1042 face
->font_name
= font_info
->full_name
;
1044 /* Make the registry part of the font name readily accessible.
1045 The registry is used to find suitable faces for unibyte text. */
1046 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1048 while (i
< 2 && --s
>= font_info
->full_name
)
1052 if (!STRINGP (face
->registry
)
1053 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1055 if (STRINGP (Vface_default_registry
)
1056 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1057 face
->registry
= Vface_default_registry
;
1059 face
->registry
= build_string (s
+ 1);
1062 else if (fontset
>= 0)
1063 add_to_log ("Unable to load ASCII font of fontset %d",
1064 make_number (fontset
), Qnil
);
1066 add_to_log ("Unable to load font %s",
1067 build_string (font_name
), Qnil
);
1070 #endif /* HAVE_X_WINDOWS */
1074 /***********************************************************************
1076 ***********************************************************************/
1078 /* A version of defined_color for non-X frames. */
1080 tty_defined_color (f
, color_name
, color_def
, alloc
)
1086 Lisp_Object color_desc
;
1087 int color_idx
= FACE_TTY_DEFAULT_COLOR
, red
= 0, green
= 0, blue
= 0;
1090 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1093 color_desc
= call1 (Qtty_color_desc
, build_string (color_name
));
1094 if (!NILP (color_desc
) && CONSP (color_desc
))
1096 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1097 if (CONSP (XCDR (XCDR (color_desc
))))
1099 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1100 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1101 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1105 else if (NILP (Fsymbol_value (intern ("tty-color-alist"))))
1106 /* We were called early during startup, and the colors are not
1107 yet set up in tty-color-alist. Don't return a failure
1108 indication, since this produces the annoying "Unable to
1109 load color" messages in the *Messages* buffer. */
1112 color_def
->pixel
= (unsigned long) color_idx
;
1113 color_def
->red
= red
;
1114 color_def
->green
= green
;
1115 color_def
->blue
= blue
;
1120 /* Decide if color named COLOR is valid for the display associated
1121 with the frame F; if so, return the rgb values in COLOR_DEF. If
1122 ALLOC is nonzero, allocate a new colormap cell.
1124 This does the right thing for any type of frame. */
1126 defined_color (f
, color_name
, color_def
, alloc
)
1132 if (!FRAME_WINDOW_P (f
))
1133 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1134 #ifdef HAVE_X_WINDOWS
1135 else if (FRAME_X_P (f
))
1136 return x_defined_color (f
, color_name
, color_def
, alloc
);
1139 else if (FRAME_W32_P (f
))
1140 /* FIXME: w32_defined_color doesn't exist! w32fns.c defines
1141 defined_color which needs to be renamed, and the declaration
1142 of color_def therein should be changed. */
1143 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1146 else if (FRAME_MAC_P (f
))
1147 /* FIXME: mac_defined_color doesn't exist! */
1148 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1154 /* Given the index of the tty color, return its name, a Lisp string. */
1157 tty_color_name (f
, idx
)
1163 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1165 Lisp_Object coldesc
= call1 (Qtty_color_by_index
, make_number (idx
));
1167 if (!NILP (coldesc
))
1168 return XCAR (coldesc
);
1171 /* We can have an MSDOG frame under -nw for a short window of
1172 opportunity before internal_terminal_init is called. DTRT. */
1173 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1174 return msdos_stdcolor_name (idx
);
1178 /* FIXME: When/if w32 supports colors in non-window mode, there should
1179 be a call here to a w32-specific function that returns the color
1180 by index using the default color mapping on a Windows console. */
1183 return Qunspecified
;
1186 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1187 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1190 face_color_gray_p (f
, color_name
)
1197 if (defined_color (f
, color_name
, &color
, 0))
1198 gray_p
= ((abs (color
.red
- color
.green
)
1199 < max (color
.red
, color
.green
) / 20)
1200 && (abs (color
.green
- color
.blue
)
1201 < max (color
.green
, color
.blue
) / 20)
1202 && (abs (color
.blue
- color
.red
)
1203 < max (color
.blue
, color
.red
) / 20));
1211 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1212 BACKGROUND_P non-zero means the color will be used as background
1216 face_color_supported_p (f
, color_name
, background_p
)
1224 XSETFRAME (frame
, f
);
1225 return ((FRAME_WINDOW_P (f
)
1226 && (!NILP (Fxw_display_color_p (frame
))
1227 || xstricmp (color_name
, "black") == 0
1228 || xstricmp (color_name
, "white") == 0
1230 && face_color_gray_p (f
, color_name
))
1231 || (!NILP (Fx_display_grayscale_p (frame
))
1232 && face_color_gray_p (f
, color_name
))))
1233 || tty_defined_color (f
, color_name
, ¬_used
, 0));
1237 DEFUN ("face-color-gray-p", Fface_color_gray_p
, Sface_color_gray_p
, 1, 2, 0,
1238 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1239 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1240 If FRAME is nil or omitted, use the selected frame.")
1242 Lisp_Object color
, frame
;
1246 CHECK_FRAME (frame
, 0);
1247 CHECK_STRING (color
, 0);
1249 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1253 DEFUN ("face-color-supported-p", Fface_color_supported_p
,
1254 Sface_color_supported_p
, 2, 3, 0,
1255 "Return non-nil if COLOR can be displayed on FRAME.\n\
1256 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1257 If FRAME is nil or omitted, use the selected frame.\n\
1258 COLOR must be a valid color name.")
1259 (frame
, color
, background_p
)
1260 Lisp_Object frame
, color
, background_p
;
1264 CHECK_FRAME (frame
, 0);
1265 CHECK_STRING (color
, 0);
1267 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1272 /* Load color with name NAME for use by face FACE on frame F.
1273 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1274 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1275 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1276 pixel color. If color cannot be loaded, display a message, and
1277 return the foreground, background or underline color of F, but
1278 record that fact in flags of the face so that we don't try to free
1282 load_color (f
, face
, name
, target_index
)
1286 enum lface_attribute_index target_index
;
1290 xassert (STRINGP (name
));
1291 xassert (target_index
== LFACE_FOREGROUND_INDEX
1292 || target_index
== LFACE_BACKGROUND_INDEX
1293 || target_index
== LFACE_UNDERLINE_INDEX
1294 || target_index
== LFACE_OVERLINE_INDEX
1295 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1296 || target_index
== LFACE_BOX_INDEX
);
1298 /* if the color map is full, defined_color will return a best match
1299 to the values in an existing cell. */
1300 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1302 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1304 switch (target_index
)
1306 case LFACE_FOREGROUND_INDEX
:
1307 face
->foreground_defaulted_p
= 1;
1308 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1311 case LFACE_BACKGROUND_INDEX
:
1312 face
->background_defaulted_p
= 1;
1313 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1316 case LFACE_UNDERLINE_INDEX
:
1317 face
->underline_defaulted_p
= 1;
1318 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1321 case LFACE_OVERLINE_INDEX
:
1322 face
->overline_color_defaulted_p
= 1;
1323 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1326 case LFACE_STRIKE_THROUGH_INDEX
:
1327 face
->strike_through_color_defaulted_p
= 1;
1328 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1331 case LFACE_BOX_INDEX
:
1332 face
->box_color_defaulted_p
= 1;
1333 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1342 ++ncolors_allocated
;
1348 #ifdef HAVE_X_WINDOWS
1350 /* Load colors for face FACE which is used on frame F. Colors are
1351 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1352 of ATTRS. If the background color specified is not supported on F,
1353 try to emulate gray colors with a stipple from Vface_default_stipple. */
1356 load_face_colors (f
, face
, attrs
)
1363 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1364 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1366 /* Swap colors if face is inverse-video. */
1367 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1375 /* Check for support for foreground, not for background because
1376 face_color_supported_p is smart enough to know that grays are
1377 "supported" as background because we are supposed to use stipple
1379 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1380 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1382 x_destroy_bitmap (f
, face
->stipple
);
1383 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1384 &face
->pixmap_w
, &face
->pixmap_h
);
1387 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1388 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1392 /* Free color PIXEL on frame F. */
1395 unload_color (f
, pixel
)
1397 unsigned long pixel
;
1399 Display
*dpy
= FRAME_X_DISPLAY (f
);
1400 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1402 if (pixel
== BLACK_PIX_DEFAULT (f
)
1403 || pixel
== WHITE_PIX_DEFAULT (f
))
1408 /* If display has an immutable color map, freeing colors is not
1409 necessary and some servers don't allow it. So don't do it. */
1410 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1412 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1413 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1420 /* Free colors allocated for FACE. */
1423 free_face_colors (f
, face
)
1427 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1429 /* If display has an immutable color map, freeing colors is not
1430 necessary and some servers don't allow it. So don't do it. */
1431 if (class != StaticColor
1432 && class != StaticGray
1433 && class != TrueColor
)
1439 dpy
= FRAME_X_DISPLAY (f
);
1440 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1442 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1443 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1444 && !face
->foreground_defaulted_p
)
1446 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1447 IF_DEBUG (--ncolors_allocated
);
1450 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1451 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1452 && !face
->background_defaulted_p
)
1454 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1455 IF_DEBUG (--ncolors_allocated
);
1458 if (face
->underline_p
1459 && !face
->underline_defaulted_p
1460 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1461 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1463 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1464 IF_DEBUG (--ncolors_allocated
);
1467 if (face
->overline_p
1468 && !face
->overline_color_defaulted_p
1469 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1470 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1472 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1473 IF_DEBUG (--ncolors_allocated
);
1476 if (face
->strike_through_p
1477 && !face
->strike_through_color_defaulted_p
1478 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1479 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1481 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1482 IF_DEBUG (--ncolors_allocated
);
1485 if (face
->box
!= FACE_NO_BOX
1486 && !face
->box_color_defaulted_p
1487 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1488 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1490 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1491 IF_DEBUG (--ncolors_allocated
);
1497 #endif /* HAVE_X_WINDOWS */
1501 /***********************************************************************
1503 ***********************************************************************/
1505 /* An enumerator for each field of an XLFD font name. */
1526 /* An enumerator for each possible slant value of a font. Taken from
1527 the XLFD specification. */
1535 XLFD_SLANT_REVERSE_ITALIC
,
1536 XLFD_SLANT_REVERSE_OBLIQUE
,
1540 /* Relative font weight according to XLFD documentation. */
1544 XLFD_WEIGHT_UNKNOWN
,
1545 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1546 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1547 XLFD_WEIGHT_LIGHT
, /* 30 */
1548 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1549 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1550 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1551 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1552 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1553 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1556 /* Relative proportionate width. */
1560 XLFD_SWIDTH_UNKNOWN
,
1561 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1562 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1563 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1564 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1565 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1566 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1567 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1568 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1569 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1572 /* Structure used for tables mapping XLFD weight, slant, and width
1573 names to numeric and symbolic values. */
1579 Lisp_Object
*symbol
;
1582 /* Table of XLFD slant names and their numeric and symbolic
1583 representations. This table must be sorted by slant names in
1586 static struct table_entry slant_table
[] =
1588 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1589 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1590 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1591 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1592 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1593 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1596 /* Table of XLFD weight names. This table must be sorted by weight
1597 names in ascending order. */
1599 static struct table_entry weight_table
[] =
1601 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1602 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1603 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1604 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1605 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1606 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1607 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1608 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1609 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1610 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1611 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1612 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1613 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1614 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1615 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1618 /* Table of XLFD width names. This table must be sorted by width
1619 names in ascending order. */
1621 static struct table_entry swidth_table
[] =
1623 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1624 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1625 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1626 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1627 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1628 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1629 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1630 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1631 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1632 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1633 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1634 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1635 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1636 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1637 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1640 /* Structure used to hold the result of splitting font names in XLFD
1641 format into their fields. */
1645 /* The original name which is modified destructively by
1646 split_font_name. The pointer is kept here to be able to free it
1647 if it was allocated from the heap. */
1650 /* Font name fields. Each vector element points into `name' above.
1651 Fields are NUL-terminated. */
1652 char *fields
[XLFD_LAST
];
1654 /* Numeric values for those fields that interest us. See
1655 split_font_name for which these are. */
1656 int numeric
[XLFD_LAST
];
1659 /* The frame in effect when sorting font names. Set temporarily in
1660 sort_fonts so that it is available in font comparison functions. */
1662 static struct frame
*font_frame
;
1664 /* Order by which font selection chooses fonts. The default values
1665 mean `first, find a best match for the font width, then for the
1666 font height, then for weight, then for slant.' This variable can be
1667 set via set-face-font-sort-order. */
1669 static int font_sort_order
[4];
1672 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1673 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1674 is a pointer to the matching table entry or null if no table entry
1677 static struct table_entry
*
1678 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1679 struct table_entry
*table
;
1681 struct font_name
*font
;
1684 /* Function split_font_name converts fields to lower-case, so there
1685 is no need to use xstrlwr or xstricmp here. */
1686 char *s
= font
->fields
[field_index
];
1687 int low
, mid
, high
, cmp
;
1694 mid
= (low
+ high
) / 2;
1695 cmp
= strcmp (table
[mid
].name
, s
);
1709 /* Return a numeric representation for font name field
1710 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1711 has DIM entries. Value is the numeric value found or DFLT if no
1712 table entry matches. This function is used to translate weight,
1713 slant, and swidth names of XLFD font names to numeric values. */
1716 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1717 struct table_entry
*table
;
1719 struct font_name
*font
;
1723 struct table_entry
*p
;
1724 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1725 return p
? p
->numeric
: dflt
;
1729 /* Return a symbolic representation for font name field
1730 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1731 has DIM entries. Value is the symbolic value found or DFLT if no
1732 table entry matches. This function is used to translate weight,
1733 slant, and swidth names of XLFD font names to symbols. */
1735 static INLINE Lisp_Object
1736 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1737 struct table_entry
*table
;
1739 struct font_name
*font
;
1743 struct table_entry
*p
;
1744 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1745 return p
? *p
->symbol
: dflt
;
1749 /* Return a numeric value for the slant of the font given by FONT. */
1752 xlfd_numeric_slant (font
)
1753 struct font_name
*font
;
1755 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1756 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1760 /* Return a symbol representing the weight of the font given by FONT. */
1762 static INLINE Lisp_Object
1763 xlfd_symbolic_slant (font
)
1764 struct font_name
*font
;
1766 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1767 font
, XLFD_SLANT
, Qnormal
);
1771 /* Return a numeric value for the weight of the font given by FONT. */
1774 xlfd_numeric_weight (font
)
1775 struct font_name
*font
;
1777 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1778 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1782 /* Return a symbol representing the slant of the font given by FONT. */
1784 static INLINE Lisp_Object
1785 xlfd_symbolic_weight (font
)
1786 struct font_name
*font
;
1788 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1789 font
, XLFD_WEIGHT
, Qnormal
);
1793 /* Return a numeric value for the swidth of the font whose XLFD font
1794 name fields are found in FONT. */
1797 xlfd_numeric_swidth (font
)
1798 struct font_name
*font
;
1800 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1801 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1805 /* Return a symbolic value for the swidth of FONT. */
1807 static INLINE Lisp_Object
1808 xlfd_symbolic_swidth (font
)
1809 struct font_name
*font
;
1811 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1812 font
, XLFD_SWIDTH
, Qnormal
);
1816 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1817 entries. Value is a pointer to the matching table entry or null if
1818 no element of TABLE contains SYMBOL. */
1820 static struct table_entry
*
1821 face_value (table
, dim
, symbol
)
1822 struct table_entry
*table
;
1828 xassert (SYMBOLP (symbol
));
1830 for (i
= 0; i
< dim
; ++i
)
1831 if (EQ (*table
[i
].symbol
, symbol
))
1834 return i
< dim
? table
+ i
: NULL
;
1838 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1839 entries. Value is -1 if SYMBOL is not found in TABLE. */
1842 face_numeric_value (table
, dim
, symbol
)
1843 struct table_entry
*table
;
1847 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1848 return p
? p
->numeric
: -1;
1852 /* Return a numeric value representing the weight specified by Lisp
1853 symbol WEIGHT. Value is one of the enumerators of enum
1857 face_numeric_weight (weight
)
1860 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1864 /* Return a numeric value representing the slant specified by Lisp
1865 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1868 face_numeric_slant (slant
)
1871 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1875 /* Return a numeric value representing the swidth specified by Lisp
1876 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1879 face_numeric_swidth (width
)
1882 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1886 #ifdef HAVE_X_WINDOWS
1888 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1892 struct font_name
*font
;
1894 /* Function split_font_name converts fields to lower-case, so there
1895 is no need to use tolower here. */
1896 return *font
->fields
[XLFD_SPACING
] != 'p';
1900 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1902 The actual height of the font when displayed on F depends on the
1903 resolution of both the font and frame. For example, a 10pt font
1904 designed for a 100dpi display will display larger than 10pt on a
1905 75dpi display. (It's not unusual to use fonts not designed for the
1906 display one is using. For example, some intlfonts are available in
1907 72dpi versions, only.)
1909 Value is the real point size of FONT on frame F, or 0 if it cannot
1913 xlfd_point_size (f
, font
)
1915 struct font_name
*font
;
1917 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1918 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1919 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1922 if (font_resy
== 0 || font_pt
== 0)
1925 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1931 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1932 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1933 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1934 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1935 zero if the font name doesn't have the format we expect. The
1936 expected format is a font name that starts with a `-' and has
1937 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1938 forms of font names where certain field contents are enclosed in
1939 square brackets. We don't support that, for now. */
1942 split_font_name (f
, font
, numeric_p
)
1944 struct font_name
*font
;
1950 if (*font
->name
== '-')
1952 char *p
= xstrlwr (font
->name
) + 1;
1954 while (i
< XLFD_LAST
)
1956 font
->fields
[i
] = p
;
1959 while (*p
&& *p
!= '-')
1969 success_p
= i
== XLFD_LAST
;
1971 /* If requested, and font name was in the expected format,
1972 compute numeric values for some fields. */
1973 if (numeric_p
&& success_p
)
1975 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1976 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1977 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1978 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1979 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
1986 /* Build an XLFD font name from font name fields in FONT. Value is a
1987 pointer to the font name, which is allocated via xmalloc. */
1990 build_font_name (font
)
1991 struct font_name
*font
;
1995 char *font_name
= (char *) xmalloc (size
);
1996 int total_length
= 0;
1998 for (i
= 0; i
< XLFD_LAST
; ++i
)
2000 /* Add 1 because of the leading `-'. */
2001 int len
= strlen (font
->fields
[i
]) + 1;
2003 /* Reallocate font_name if necessary. Add 1 for the final
2005 if (total_length
+ len
+ 1 >= size
)
2007 int new_size
= max (2 * size
, size
+ len
+ 1);
2008 int sz
= new_size
* sizeof *font_name
;
2009 font_name
= (char *) xrealloc (font_name
, sz
);
2013 font_name
[total_length
] = '-';
2014 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2015 total_length
+= len
;
2018 font_name
[total_length
] = 0;
2023 /* Free an array FONTS of N font_name structures. This frees FONTS
2024 itself and all `name' fields in its elements. */
2027 free_font_names (fonts
, n
)
2028 struct font_name
*fonts
;
2032 xfree (fonts
[--n
].name
);
2037 /* Sort vector FONTS of font_name structures which contains NFONTS
2038 elements using qsort and comparison function CMPFN. F is the frame
2039 on which the fonts will be used. The global variable font_frame
2040 is temporarily set to F to make it available in CMPFN. */
2043 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2045 struct font_name
*fonts
;
2047 int (*cmpfn
) P_ ((const void *, const void *));
2050 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2055 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2056 display in x_display_list. FONTS is a pointer to a vector of
2057 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2058 alternative patterns from Valternate_fontname_alist if no fonts are
2059 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2062 For all fonts found, set FONTS[i].name to the name of the font,
2063 allocated via xmalloc, and split font names into fields. Ignore
2064 fonts that we can't parse. Value is the number of fonts found.
2066 This is similar to x_list_fonts. The differences are:
2068 1. It avoids consing.
2069 2. It never calls XLoadQueryFont. */
2072 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2076 struct font_name
*fonts
;
2077 int nfonts
, try_alternatives_p
;
2078 int scalable_fonts_p
;
2080 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2084 /* Get the list of fonts matching PATTERN from the X server. */
2086 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2091 /* Make a copy of the font names we got from X, and
2092 split them into fields. */
2093 for (i
= j
= 0; i
< n
; ++i
)
2095 /* Make a copy of the font name. */
2096 fonts
[j
].name
= xstrdup (names
[i
]);
2098 /* Ignore fonts having a name that we can't parse. */
2099 if (!split_font_name (f
, fonts
+ j
, 1))
2100 xfree (fonts
[j
].name
);
2101 else if (font_scalable_p (fonts
+ j
))
2104 if (!scalable_fonts_p
2105 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2106 xfree (fonts
[j
].name
);
2109 #else /* !SCALABLE_FONTS */
2110 /* Always ignore scalable fonts. */
2111 xfree (fonts
[j
].name
);
2112 #endif /* !SCALABLE_FONTS */
2120 /* Free font names. */
2122 XFreeFontNames (names
);
2127 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2128 if (n
== 0 && try_alternatives_p
)
2130 Lisp_Object list
= Valternate_fontname_alist
;
2132 while (CONSP (list
))
2134 Lisp_Object entry
= XCAR (list
);
2136 && STRINGP (XCAR (entry
))
2137 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2144 Lisp_Object patterns
= XCAR (list
);
2147 while (CONSP (patterns
)
2148 /* If list is screwed up, give up. */
2149 && (name
= XCAR (patterns
),
2151 /* Ignore patterns equal to PATTERN because we tried that
2152 already with no success. */
2153 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2154 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2158 patterns
= XCDR (patterns
);
2166 /* Determine the first font matching PATTERN on frame F. Return in
2167 *FONT the matching font name, split into fields. Value is non-zero
2168 if a match was found. */
2171 first_font_matching (f
, pattern
, font
)
2174 struct font_name
*font
;
2177 struct font_name
*fonts
;
2179 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2180 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2184 bcopy (&fonts
[0], font
, sizeof *font
);
2186 fonts
[0].name
= NULL
;
2187 free_font_names (fonts
, nfonts
);
2194 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2195 using comparison function CMPFN. Value is the number of fonts
2196 found. If value is non-zero, *FONTS is set to a vector of
2197 font_name structures allocated from the heap containing matching
2198 fonts. Each element of *FONTS contains a name member that is also
2199 allocated from the heap. Font names in these structures are split
2200 into fields. Use free_font_names to free such an array. */
2203 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2206 int (*cmpfn
) P_ ((const void *, const void *));
2207 struct font_name
**fonts
;
2211 /* Get the list of fonts matching pattern. 100 should suffice. */
2212 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2213 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2214 nfonts
= XFASTINT (Vfont_list_limit
);
2216 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2218 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2220 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2223 /* Sort the resulting array and return it in *FONTS. If no
2224 fonts were found, make sure to set *FONTS to null. */
2226 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2237 /* Compare two font_name structures *A and *B. Value is analogous to
2238 strcmp. Sort order is given by the global variable
2239 font_sort_order. Font names are sorted so that, everything else
2240 being equal, fonts with a resolution closer to that of the frame on
2241 which they are used are listed first. The global variable
2242 font_frame is the frame on which we operate. */
2245 cmp_font_names (a
, b
)
2248 struct font_name
*x
= (struct font_name
*) a
;
2249 struct font_name
*y
= (struct font_name
*) b
;
2252 /* All strings have been converted to lower-case by split_font_name,
2253 so we can use strcmp here. */
2254 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2259 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2261 int j
= font_sort_order
[i
];
2262 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2267 /* Everything else being equal, we prefer fonts with an
2268 y-resolution closer to that of the frame. */
2269 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2270 int x_resy
= x
->numeric
[XLFD_RESY
];
2271 int y_resy
= y
->numeric
[XLFD_RESY
];
2272 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2280 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2281 is non-null list fonts matching that pattern. Otherwise, if
2282 REGISTRY_AND_ENCODING is non-null return only fonts with that
2283 registry and encoding, otherwise return fonts of any registry and
2284 encoding. Set *FONTS to a vector of font_name structures allocated
2285 from the heap containing the fonts found. Value is the number of
2289 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2293 char *registry_and_encoding
;
2294 struct font_name
**fonts
;
2296 if (pattern
== NULL
)
2301 if (registry_and_encoding
== NULL
)
2302 registry_and_encoding
= "*";
2304 pattern
= (char *) alloca (strlen (family
)
2305 + strlen (registry_and_encoding
)
2307 if (index (family
, '-'))
2308 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2310 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2313 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2317 /* Remove elements from LIST whose cars are `equal'. Called from
2318 x-family-fonts and x-font-family-list to remove duplicate font
2322 remove_duplicates (list
)
2325 Lisp_Object tail
= list
;
2327 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2329 Lisp_Object next
= XCDR (tail
);
2330 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2331 XCDR (tail
) = XCDR (next
);
2338 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2339 "Return a list of available fonts of family FAMILY on FRAME.\n\
2340 If FAMILY is omitted or nil, list all families.\n\
2341 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2343 If FRAME is omitted or nil, use the selected frame.\n\
2344 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2345 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2346 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2347 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2348 width, weight and slant of the font. These symbols are the same as for\n\
2349 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2350 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2351 giving the registry and encoding of the font.\n\
2352 The result list is sorted according to the current setting of\n\
2353 the face font sort order.")
2355 Lisp_Object family
, frame
;
2357 struct frame
*f
= check_x_frame (frame
);
2358 struct font_name
*fonts
;
2361 struct gcpro gcpro1
;
2362 char *family_pattern
;
2365 family_pattern
= "*";
2368 CHECK_STRING (family
, 1);
2369 family_pattern
= LSTRDUPA (family
);
2374 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2375 for (i
= nfonts
- 1; i
>= 0; --i
)
2377 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2380 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2382 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2383 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2384 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2385 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2386 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2387 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2388 tem
= build_font_name (fonts
+ i
);
2389 ASET (v
, 6, build_string (tem
));
2390 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2391 fonts
[i
].fields
[XLFD_ENCODING
]);
2392 ASET (v
, 7, build_string (tem
));
2395 result
= Fcons (v
, result
);
2400 remove_duplicates (result
);
2401 free_font_names (fonts
, nfonts
);
2407 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2409 "Return a list of available font families on FRAME.\n\
2410 If FRAME is omitted or nil, use the selected frame.\n\
2411 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2412 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2417 struct frame
*f
= check_x_frame (frame
);
2419 struct font_name
*fonts
;
2421 struct gcpro gcpro1
;
2422 int count
= specpdl_ptr
- specpdl
;
2425 /* Let's consider all fonts. Increase the limit for matching
2426 fonts until we have them all. */
2429 specbind (intern ("font-list-limit"), make_number (limit
));
2430 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2432 if (nfonts
== limit
)
2434 free_font_names (fonts
, nfonts
);
2443 for (i
= nfonts
- 1; i
>= 0; --i
)
2444 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2445 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2448 remove_duplicates (result
);
2449 free_font_names (fonts
, nfonts
);
2451 return unbind_to (count
, result
);
2455 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2456 "Return a list of the names of available fonts matching PATTERN.\n\
2457 If optional arguments FACE and FRAME are specified, return only fonts\n\
2458 the same size as FACE on FRAME.\n\
2459 PATTERN is a string, perhaps with wildcard characters;\n\
2460 the * character matches any substring, and\n\
2461 the ? character matches any single character.\n\
2462 PATTERN is case-insensitive.\n\
2463 FACE is a face name--a symbol.\n\
2465 The return value is a list of strings, suitable as arguments to\n\
2468 Fonts Emacs can't use may or may not be excluded\n\
2469 even if they match PATTERN and FACE.\n\
2470 The optional fourth argument MAXIMUM sets a limit on how many\n\
2471 fonts to match. The first MAXIMUM fonts are reported.\n\
2472 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2473 occupied by a character of a font. In that case, return only fonts\n\
2474 the WIDTH times as wide as FACE on FRAME.")
2475 (pattern
, face
, frame
, maximum
, width
)
2476 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2483 CHECK_STRING (pattern
, 0);
2489 CHECK_NATNUM (maximum
, 0);
2490 maxnames
= XINT (maximum
);
2494 CHECK_NUMBER (width
, 4);
2496 /* We can't simply call check_x_frame because this function may be
2497 called before any frame is created. */
2498 f
= frame_or_selected_frame (frame
, 2);
2501 /* Perhaps we have not yet created any frame. */
2506 /* Determine the width standard for comparison with the fonts we find. */
2512 /* This is of limited utility since it works with character
2513 widths. Keep it for compatibility. --gerd. */
2514 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2515 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2518 size
= face
->font
->max_bounds
.width
;
2520 size
= FRAME_FONT (f
)->max_bounds
.width
;
2523 size
*= XINT (width
);
2527 Lisp_Object args
[2];
2529 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2531 /* We don't have to check fontsets. */
2533 args
[1] = list_fontsets (f
, pattern
, size
);
2534 return Fnconc (2, args
);
2538 #endif /* HAVE_X_WINDOWS */
2542 /***********************************************************************
2544 ***********************************************************************/
2546 /* Access face attributes of face FACE, a Lisp vector. */
2548 #define LFACE_FAMILY(LFACE) \
2549 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2550 #define LFACE_HEIGHT(LFACE) \
2551 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2552 #define LFACE_WEIGHT(LFACE) \
2553 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2554 #define LFACE_SLANT(LFACE) \
2555 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2556 #define LFACE_UNDERLINE(LFACE) \
2557 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2558 #define LFACE_INVERSE(LFACE) \
2559 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2560 #define LFACE_FOREGROUND(LFACE) \
2561 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2562 #define LFACE_BACKGROUND(LFACE) \
2563 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2564 #define LFACE_STIPPLE(LFACE) \
2565 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2566 #define LFACE_SWIDTH(LFACE) \
2567 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2568 #define LFACE_OVERLINE(LFACE) \
2569 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2570 #define LFACE_STRIKE_THROUGH(LFACE) \
2571 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2572 #define LFACE_BOX(LFACE) \
2573 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2575 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2576 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2578 #define LFACEP(LFACE) \
2580 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2581 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2586 /* Check consistency of Lisp face attribute vector ATTRS. */
2589 check_lface_attrs (attrs
)
2592 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2593 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2594 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2595 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2596 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2597 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2598 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2599 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2600 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2601 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2602 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2603 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2604 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2605 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2606 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2607 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2608 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2609 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2610 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2611 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2612 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2613 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2614 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2615 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2616 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2617 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2618 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2619 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2620 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2621 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2622 #ifdef HAVE_WINDOW_SYSTEM
2623 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2624 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2625 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2630 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2638 xassert (LFACEP (lface
));
2639 check_lface_attrs (XVECTOR (lface
)->contents
);
2643 #else /* GLYPH_DEBUG == 0 */
2645 #define check_lface_attrs(attrs) (void) 0
2646 #define check_lface(lface) (void) 0
2648 #endif /* GLYPH_DEBUG == 0 */
2651 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2652 to make it a symvol. If FACE_NAME is an alias for another face,
2653 return that face's name. */
2656 resolve_face_name (face_name
)
2657 Lisp_Object face_name
;
2659 Lisp_Object aliased
;
2661 if (STRINGP (face_name
))
2662 face_name
= intern (XSTRING (face_name
)->data
);
2666 aliased
= Fget (face_name
, Qface_alias
);
2670 face_name
= aliased
;
2677 /* Return the face definition of FACE_NAME on frame F. F null means
2678 return the global definition. FACE_NAME may be a string or a
2679 symbol (apparently Emacs 20.2 allows strings as face names in face
2680 text properties; ediff uses that). If FACE_NAME is an alias for
2681 another face, return that face's definition. If SIGNAL_P is
2682 non-zero, signal an error if FACE_NAME is not a valid face name.
2683 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2686 static INLINE Lisp_Object
2687 lface_from_face_name (f
, face_name
, signal_p
)
2689 Lisp_Object face_name
;
2694 face_name
= resolve_face_name (face_name
);
2697 lface
= assq_no_quit (face_name
, f
->face_alist
);
2699 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2702 lface
= XCDR (lface
);
2704 signal_error ("Invalid face", face_name
);
2706 check_lface (lface
);
2711 /* Get face attributes of face FACE_NAME from frame-local faces on
2712 frame F. Store the resulting attributes in ATTRS which must point
2713 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2714 is non-zero, signal an error if FACE_NAME does not name a face.
2715 Otherwise, value is zero if FACE_NAME is not a face. */
2718 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2720 Lisp_Object face_name
;
2727 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2730 bcopy (XVECTOR (lface
)->contents
, attrs
,
2731 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2741 /* Non-zero if all attributes in face attribute vector ATTRS are
2742 specified, i.e. are non-nil. */
2745 lface_fully_specified_p (attrs
)
2750 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2751 if (UNSPECIFIEDP (attrs
[i
]))
2754 return i
== LFACE_VECTOR_SIZE
;
2758 #ifdef HAVE_X_WINDOWS
2760 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2761 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2762 LFACE. MAY_FAIL_P non-zero means return 0 if FONT_NAME isn't a
2763 valid font name; otherwise this function tries to use a reasonable
2766 Ignore fields of FONT_NAME containing wildcards. Value is zero if
2767 not successful because FONT_NAME was not in a valid format and
2768 MAY_FAIL_P was non-zero. A valid format is one that is suitable
2769 for split_font_name, see the comment there. */
2772 set_lface_from_font_name (f
, lface
, font_name
, force_p
, may_fail_p
)
2776 int force_p
, may_fail_p
;
2778 struct font_name font
;
2781 int free_font_name_p
= 0;
2782 int have_font_p
= 0;
2784 /* If FONT_NAME contains wildcards, use the first matching font. */
2785 if (index (font_name
, '*') || index (font_name
, '?'))
2787 if (first_font_matching (f
, font_name
, &font
))
2788 free_font_name_p
= have_font_p
= 1;
2792 font
.name
= STRDUPA (font_name
);
2793 if (split_font_name (f
, &font
, 1))
2797 /* The font name may be something like `6x13'. Make
2798 sure we use the full name. */
2799 struct font_info
*font_info
;
2802 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2803 CHARSET_ASCII
, font_name
, -1);
2806 font
.name
= STRDUPA (font_info
->full_name
);
2807 split_font_name (f
, &font
, 1);
2814 /* If FONT_NAME is completely bogus try to use something reasonable
2815 if this function must succeed. Otherwise, give up. */
2820 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2822 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2824 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2826 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2828 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2830 || first_font_matching (f
, "fixed", &font
))
2831 free_font_name_p
= 1;
2837 /* Set attributes only if unspecified, otherwise face defaults for
2838 new frames would never take effect. */
2840 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2842 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2843 + strlen (font
.fields
[XLFD_FOUNDRY
])
2845 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2846 font
.fields
[XLFD_FAMILY
]);
2847 LFACE_FAMILY (lface
) = build_string (buffer
);
2850 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2852 pt
= xlfd_point_size (f
, &font
);
2854 LFACE_HEIGHT (lface
) = make_number (pt
);
2857 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2858 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2860 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2861 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2863 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2864 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2866 if (free_font_name_p
)
2872 #endif /* HAVE_X_WINDOWS */
2875 /* Merge two Lisp face attribute vectors FROM and TO and store the
2876 resulting attributes in TO. Every non-nil attribute of FROM
2877 overrides the corresponding attribute of TO. */
2880 merge_face_vectors (from
, to
)
2881 Lisp_Object
*from
, *to
;
2884 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2885 if (!UNSPECIFIEDP (from
[i
]))
2890 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2891 is a face property, determine the resulting face attributes on
2892 frame F, and store them in TO. PROP may be a single face
2893 specification or a list of such specifications. Each face
2894 specification can be
2896 1. A symbol or string naming a Lisp face.
2898 2. A property list of the form (KEYWORD VALUE ...) where each
2899 KEYWORD is a face attribute name, and value is an appropriate value
2902 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2903 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2904 for compatibility with 20.2.
2906 Face specifications earlier in lists take precedence over later
2910 merge_face_vector_with_property (f
, to
, prop
)
2917 Lisp_Object first
= XCAR (prop
);
2919 if (EQ (first
, Qforeground_color
)
2920 || EQ (first
, Qbackground_color
))
2922 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2923 . COLOR). COLOR must be a string. */
2924 Lisp_Object color_name
= XCDR (prop
);
2925 Lisp_Object color
= first
;
2927 if (STRINGP (color_name
))
2929 if (EQ (color
, Qforeground_color
))
2930 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2932 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2935 add_to_log ("Invalid face color", color_name
, Qnil
);
2937 else if (SYMBOLP (first
)
2938 && *XSYMBOL (first
)->name
->data
== ':')
2940 /* Assume this is the property list form. */
2941 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2943 Lisp_Object keyword
= XCAR (prop
);
2944 Lisp_Object value
= XCAR (XCDR (prop
));
2946 if (EQ (keyword
, QCfamily
))
2948 if (STRINGP (value
))
2949 to
[LFACE_FAMILY_INDEX
] = value
;
2951 add_to_log ("Illegal face font family", value
, Qnil
);
2953 else if (EQ (keyword
, QCheight
))
2955 if (INTEGERP (value
))
2956 to
[LFACE_HEIGHT_INDEX
] = value
;
2958 add_to_log ("Illegal face font height", value
, Qnil
);
2960 else if (EQ (keyword
, QCweight
))
2963 && face_numeric_weight (value
) >= 0)
2964 to
[LFACE_WEIGHT_INDEX
] = value
;
2966 add_to_log ("Illegal face weight", value
, Qnil
);
2968 else if (EQ (keyword
, QCslant
))
2971 && face_numeric_slant (value
) >= 0)
2972 to
[LFACE_SLANT_INDEX
] = value
;
2974 add_to_log ("Illegal face slant", value
, Qnil
);
2976 else if (EQ (keyword
, QCunderline
))
2981 to
[LFACE_UNDERLINE_INDEX
] = value
;
2983 add_to_log ("Illegal face underline", value
, Qnil
);
2985 else if (EQ (keyword
, QCoverline
))
2990 to
[LFACE_OVERLINE_INDEX
] = value
;
2992 add_to_log ("Illegal face overline", value
, Qnil
);
2994 else if (EQ (keyword
, QCstrike_through
))
2999 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3001 add_to_log ("Illegal face strike-through", value
, Qnil
);
3003 else if (EQ (keyword
, QCbox
))
3006 value
= make_number (1);
3007 if (INTEGERP (value
)
3011 to
[LFACE_BOX_INDEX
] = value
;
3013 add_to_log ("Illegal face box", value
, Qnil
);
3015 else if (EQ (keyword
, QCinverse_video
)
3016 || EQ (keyword
, QCreverse_video
))
3018 if (EQ (value
, Qt
) || NILP (value
))
3019 to
[LFACE_INVERSE_INDEX
] = value
;
3021 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3023 else if (EQ (keyword
, QCforeground
))
3025 if (STRINGP (value
))
3026 to
[LFACE_FOREGROUND_INDEX
] = value
;
3028 add_to_log ("Illegal face foreground", value
, Qnil
);
3030 else if (EQ (keyword
, QCbackground
))
3032 if (STRINGP (value
))
3033 to
[LFACE_BACKGROUND_INDEX
] = value
;
3035 add_to_log ("Illegal face background", value
, Qnil
);
3037 else if (EQ (keyword
, QCstipple
))
3039 #ifdef HAVE_X_WINDOWS
3040 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3041 if (!NILP (pixmap_p
))
3042 to
[LFACE_STIPPLE_INDEX
] = value
;
3044 add_to_log ("Illegal face stipple", value
, Qnil
);
3047 else if (EQ (keyword
, QCwidth
))
3050 && face_numeric_swidth (value
) >= 0)
3051 to
[LFACE_SWIDTH_INDEX
] = value
;
3053 add_to_log ("Illegal face width", value
, Qnil
);
3056 add_to_log ("Invalid attribute %s in face property",
3059 prop
= XCDR (XCDR (prop
));
3064 /* This is a list of face specs. Specifications at the
3065 beginning of the list take precedence over later
3066 specifications, so we have to merge starting with the
3067 last specification. */
3068 Lisp_Object next
= XCDR (prop
);
3070 merge_face_vector_with_property (f
, to
, next
);
3071 merge_face_vector_with_property (f
, to
, first
);
3076 /* PROP ought to be a face name. */
3077 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3079 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3081 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3086 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3087 Sinternal_make_lisp_face
, 1, 2, 0,
3088 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3089 If FACE was not known as a face before, create a new one.\n\
3090 If optional argument FRAME is specified, make a frame-local face\n\
3091 for that frame. Otherwise operate on the global face definition.\n\
3092 Value is a vector of face attributes.")
3094 Lisp_Object face
, frame
;
3096 Lisp_Object global_lface
, lface
;
3100 CHECK_SYMBOL (face
, 0);
3101 global_lface
= lface_from_face_name (NULL
, face
, 0);
3105 CHECK_LIVE_FRAME (frame
, 1);
3107 lface
= lface_from_face_name (f
, face
, 0);
3110 f
= NULL
, lface
= Qnil
;
3112 /* Add a global definition if there is none. */
3113 if (NILP (global_lface
))
3115 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3117 XVECTOR (global_lface
)->contents
[0] = Qface
;
3118 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3119 Vface_new_frame_defaults
);
3121 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3122 face id to Lisp face is given by the vector lface_id_to_name.
3123 The mapping from Lisp face to Lisp face id is given by the
3124 property `face' of the Lisp face name. */
3125 if (next_lface_id
== lface_id_to_name_size
)
3127 int new_size
= max (50, 2 * lface_id_to_name_size
);
3128 int sz
= new_size
* sizeof *lface_id_to_name
;
3129 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3130 lface_id_to_name_size
= new_size
;
3133 lface_id_to_name
[next_lface_id
] = face
;
3134 Fput (face
, Qface
, make_number (next_lface_id
));
3138 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3139 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3141 /* Add a frame-local definition. */
3146 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3148 XVECTOR (lface
)->contents
[0] = Qface
;
3149 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3152 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3153 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3156 lface
= global_lface
;
3158 xassert (LFACEP (lface
));
3159 check_lface (lface
);
3164 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3165 Sinternal_lisp_face_p
, 1, 2, 0,
3166 "Return non-nil if FACE names a face.\n\
3167 If optional second parameter FRAME is non-nil, check for the\n\
3168 existence of a frame-local face with name FACE on that frame.\n\
3169 Otherwise check for the existence of a global face.")
3171 Lisp_Object face
, frame
;
3177 CHECK_LIVE_FRAME (frame
, 1);
3178 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3181 lface
= lface_from_face_name (NULL
, face
, 0);
3187 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3188 Sinternal_copy_lisp_face
, 4, 4, 0,
3189 "Copy face FROM to TO.\n\
3190 If FRAME it t, copy the global face definition of FROM to the\n\
3191 global face definition of TO. Otherwise, copy the frame-local\n\
3192 definition of FROM on FRAME to the frame-local definition of TO\n\
3193 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3196 (from
, to
, frame
, new_frame
)
3197 Lisp_Object from
, to
, frame
, new_frame
;
3199 Lisp_Object lface
, copy
;
3201 CHECK_SYMBOL (from
, 0);
3202 CHECK_SYMBOL (to
, 1);
3203 if (NILP (new_frame
))
3208 /* Copy global definition of FROM. We don't make copies of
3209 strings etc. because 20.2 didn't do it either. */
3210 lface
= lface_from_face_name (NULL
, from
, 1);
3211 copy
= Finternal_make_lisp_face (to
, Qnil
);
3215 /* Copy frame-local definition of FROM. */
3216 CHECK_LIVE_FRAME (frame
, 2);
3217 CHECK_LIVE_FRAME (new_frame
, 3);
3218 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3219 copy
= Finternal_make_lisp_face (to
, new_frame
);
3222 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3223 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3229 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3230 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3231 "Set attribute ATTR of FACE to VALUE.\n\
3232 If optional argument FRAME is given, set the face attribute of face FACE\n\
3233 on that frame. If FRAME is t, set the attribute of the default for face\n\
3234 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3236 (face
, attr
, value
, frame
)
3237 Lisp_Object face
, attr
, value
, frame
;
3240 Lisp_Object old_value
= Qnil
;
3241 int font_related_attr_p
= 0;
3243 CHECK_SYMBOL (face
, 0);
3244 CHECK_SYMBOL (attr
, 1);
3246 face
= resolve_face_name (face
);
3248 /* Set lface to the Lisp attribute vector of FACE. */
3250 lface
= lface_from_face_name (NULL
, face
, 1);
3254 frame
= selected_frame
;
3256 CHECK_LIVE_FRAME (frame
, 3);
3257 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3259 /* If a frame-local face doesn't exist yet, create one. */
3261 lface
= Finternal_make_lisp_face (face
, frame
);
3264 if (EQ (attr
, QCfamily
))
3266 if (!UNSPECIFIEDP (value
))
3268 CHECK_STRING (value
, 3);
3269 if (XSTRING (value
)->size
== 0)
3270 signal_error ("Invalid face family", value
);
3272 old_value
= LFACE_FAMILY (lface
);
3273 LFACE_FAMILY (lface
) = value
;
3274 font_related_attr_p
= 1;
3276 else if (EQ (attr
, QCheight
))
3278 if (!UNSPECIFIEDP (value
))
3280 CHECK_NUMBER (value
, 3);
3281 if (XINT (value
) <= 0)
3282 signal_error ("Invalid face height", value
);
3284 old_value
= LFACE_HEIGHT (lface
);
3285 LFACE_HEIGHT (lface
) = value
;
3286 font_related_attr_p
= 1;
3288 else if (EQ (attr
, QCweight
))
3290 if (!UNSPECIFIEDP (value
))
3292 CHECK_SYMBOL (value
, 3);
3293 if (face_numeric_weight (value
) < 0)
3294 signal_error ("Invalid face weight", value
);
3296 old_value
= LFACE_WEIGHT (lface
);
3297 LFACE_WEIGHT (lface
) = value
;
3298 font_related_attr_p
= 1;
3300 else if (EQ (attr
, QCslant
))
3302 if (!UNSPECIFIEDP (value
))
3304 CHECK_SYMBOL (value
, 3);
3305 if (face_numeric_slant (value
) < 0)
3306 signal_error ("Invalid face slant", value
);
3308 old_value
= LFACE_SLANT (lface
);
3309 LFACE_SLANT (lface
) = value
;
3310 font_related_attr_p
= 1;
3312 else if (EQ (attr
, QCunderline
))
3314 if (!UNSPECIFIEDP (value
))
3315 if ((SYMBOLP (value
)
3317 && !EQ (value
, Qnil
))
3318 /* Underline color. */
3320 && XSTRING (value
)->size
== 0))
3321 signal_error ("Invalid face underline", value
);
3323 old_value
= LFACE_UNDERLINE (lface
);
3324 LFACE_UNDERLINE (lface
) = value
;
3326 else if (EQ (attr
, QCoverline
))
3328 if (!UNSPECIFIEDP (value
))
3329 if ((SYMBOLP (value
)
3331 && !EQ (value
, Qnil
))
3332 /* Overline color. */
3334 && XSTRING (value
)->size
== 0))
3335 signal_error ("Invalid face overline", value
);
3337 old_value
= LFACE_OVERLINE (lface
);
3338 LFACE_OVERLINE (lface
) = value
;
3340 else if (EQ (attr
, QCstrike_through
))
3342 if (!UNSPECIFIEDP (value
))
3343 if ((SYMBOLP (value
)
3345 && !EQ (value
, Qnil
))
3346 /* Strike-through color. */
3348 && XSTRING (value
)->size
== 0))
3349 signal_error ("Invalid face strike-through", value
);
3351 old_value
= LFACE_STRIKE_THROUGH (lface
);
3352 LFACE_STRIKE_THROUGH (lface
) = value
;
3354 else if (EQ (attr
, QCbox
))
3358 /* Allow t meaning a simple box of width 1 in foreground color
3361 value
= make_number (1);
3363 if (UNSPECIFIEDP (value
))
3365 else if (NILP (value
))
3367 else if (INTEGERP (value
))
3368 valid_p
= XINT (value
) > 0;
3369 else if (STRINGP (value
))
3370 valid_p
= XSTRING (value
)->size
> 0;
3371 else if (CONSP (value
))
3387 if (EQ (k
, QCline_width
))
3389 if (!INTEGERP (v
) || XINT (v
) <= 0)
3392 else if (EQ (k
, QCcolor
))
3394 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3397 else if (EQ (k
, QCstyle
))
3399 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3406 valid_p
= NILP (tem
);
3412 signal_error ("Invalid face box", value
);
3414 old_value
= LFACE_BOX (lface
);
3415 LFACE_BOX (lface
) = value
;
3417 else if (EQ (attr
, QCinverse_video
)
3418 || EQ (attr
, QCreverse_video
))
3420 if (!UNSPECIFIEDP (value
))
3422 CHECK_SYMBOL (value
, 3);
3423 if (!EQ (value
, Qt
) && !NILP (value
))
3424 signal_error ("Invalid inverse-video face attribute value", value
);
3426 old_value
= LFACE_INVERSE (lface
);
3427 LFACE_INVERSE (lface
) = value
;
3429 else if (EQ (attr
, QCforeground
))
3431 if (!UNSPECIFIEDP (value
))
3433 /* Don't check for valid color names here because it depends
3434 on the frame (display) whether the color will be valid
3435 when the face is realized. */
3436 CHECK_STRING (value
, 3);
3437 if (XSTRING (value
)->size
== 0)
3438 signal_error ("Empty foreground color value", value
);
3440 old_value
= LFACE_FOREGROUND (lface
);
3441 LFACE_FOREGROUND (lface
) = value
;
3443 else if (EQ (attr
, QCbackground
))
3445 if (!UNSPECIFIEDP (value
))
3447 /* Don't check for valid color names here because it depends
3448 on the frame (display) whether the color will be valid
3449 when the face is realized. */
3450 CHECK_STRING (value
, 3);
3451 if (XSTRING (value
)->size
== 0)
3452 signal_error ("Empty background color value", value
);
3454 old_value
= LFACE_BACKGROUND (lface
);
3455 LFACE_BACKGROUND (lface
) = value
;
3457 else if (EQ (attr
, QCstipple
))
3459 #ifdef HAVE_X_WINDOWS
3460 if (!UNSPECIFIEDP (value
)
3462 && NILP (Fbitmap_spec_p (value
)))
3463 signal_error ("Invalid stipple attribute", value
);
3464 old_value
= LFACE_STIPPLE (lface
);
3465 LFACE_STIPPLE (lface
) = value
;
3466 #endif /* HAVE_X_WINDOWS */
3468 else if (EQ (attr
, QCwidth
))
3470 if (!UNSPECIFIEDP (value
))
3472 CHECK_SYMBOL (value
, 3);
3473 if (face_numeric_swidth (value
) < 0)
3474 signal_error ("Invalid face width", value
);
3476 old_value
= LFACE_SWIDTH (lface
);
3477 LFACE_SWIDTH (lface
) = value
;
3478 font_related_attr_p
= 1;
3480 else if (EQ (attr
, QCfont
))
3482 #ifdef HAVE_X_WINDOWS
3483 /* Set font-related attributes of the Lisp face from an
3487 CHECK_STRING (value
, 3);
3489 f
= SELECTED_FRAME ();
3491 f
= check_x_frame (frame
);
3493 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3494 signal_error ("Invalid font name", value
);
3496 font_related_attr_p
= 1;
3497 #endif /* HAVE_X_WINDOWS */
3499 else if (EQ (attr
, QCbold
))
3501 old_value
= LFACE_WEIGHT (lface
);
3502 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3503 font_related_attr_p
= 1;
3505 else if (EQ (attr
, QCitalic
))
3507 old_value
= LFACE_SLANT (lface
);
3508 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3509 font_related_attr_p
= 1;
3512 signal_error ("Invalid face attribute name", attr
);
3514 /* Changing a named face means that all realized faces depending on
3515 that face are invalid. Since we cannot tell which realized faces
3516 depend on the face, make sure they are all removed. This is done
3517 by incrementing face_change_count. The next call to
3518 init_iterator will then free realized faces. */
3520 && (EQ (attr
, QCfont
)
3521 || NILP (Fequal (old_value
, value
))))
3523 ++face_change_count
;
3524 ++windows_or_buffers_changed
;
3527 #ifdef HAVE_X_WINDOWS
3530 && !UNSPECIFIEDP (value
)
3531 && NILP (Fequal (old_value
, value
)))
3537 if (EQ (face
, Qdefault
))
3539 /* Changed font-related attributes of the `default' face are
3540 reflected in changed `font' frame parameters. */
3541 if (font_related_attr_p
3542 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3543 set_font_frame_param (frame
, lface
);
3544 else if (EQ (attr
, QCforeground
))
3545 param
= Qforeground_color
;
3546 else if (EQ (attr
, QCbackground
))
3547 param
= Qbackground_color
;
3549 else if (EQ (face
, Qscroll_bar
))
3551 /* Changing the colors of `scroll-bar' sets frame parameters
3552 `scroll-bar-foreground' and `scroll-bar-background'. */
3553 if (EQ (attr
, QCforeground
))
3554 param
= Qscroll_bar_foreground
;
3555 else if (EQ (attr
, QCbackground
))
3556 param
= Qscroll_bar_background
;
3558 else if (EQ (face
, Qborder
))
3560 /* Changing background color of `border' sets frame parameter
3562 if (EQ (attr
, QCbackground
))
3563 param
= Qborder_color
;
3565 else if (EQ (face
, Qcursor
))
3567 /* Changing background color of `cursor' sets frame parameter
3569 if (EQ (attr
, QCbackground
))
3570 param
= Qcursor_color
;
3572 else if (EQ (face
, Qmouse
))
3574 /* Changing background color of `mouse' sets frame parameter
3576 if (EQ (attr
, QCbackground
))
3577 param
= Qmouse_color
;
3580 if (SYMBOLP (param
))
3581 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3584 #endif /* HAVE_X_WINDOWS */
3590 #ifdef HAVE_X_WINDOWS
3592 /* Set the `font' frame parameter of FRAME according to `default' face
3593 attributes LFACE. */
3596 set_font_frame_param (frame
, lface
)
3597 Lisp_Object frame
, lface
;
3599 struct frame
*f
= XFRAME (frame
);
3600 Lisp_Object frame_font
;
3604 /* Get FRAME's font parameter. */
3605 frame_font
= Fassq (Qfont
, f
->param_alist
);
3606 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3607 frame_font
= XCDR (frame_font
);
3609 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3612 /* Frame parameter is a fontset name. Modify the fontset so
3613 that all its fonts reflect face attributes LFACE. */
3615 struct fontset_info
*fontset_info
;
3617 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3619 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3620 if (fontset_info
->fontname
[charset
])
3622 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3624 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3625 build_string (font
), frame
);
3631 /* Frame parameter is an X font name. I believe this can
3632 only happen in unibyte mode. */
3633 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3634 -1, Vface_default_registry
);
3637 store_frame_param (f
, Qfont
, build_string (font
));
3644 /* Update the corresponding face when frame parameter PARAM on frame F
3645 has been assigned the value NEW_VALUE. */
3648 update_face_from_frame_parameter (f
, param
, new_value
)
3650 Lisp_Object param
, new_value
;
3654 /* If there are no faces yet, give up. This is the case when called
3655 from Fx_create_frame, and we do the necessary things later in
3656 face-set-after-frame-defaults. */
3657 if (NILP (f
->face_alist
))
3660 if (EQ (param
, Qforeground_color
))
3662 lface
= lface_from_face_name (f
, Qdefault
, 1);
3663 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3664 ? new_value
: Qunspecified
);
3665 realize_basic_faces (f
);
3667 else if (EQ (param
, Qbackground_color
))
3671 /* Changing the background color might change the background
3672 mode, so that we have to load new defface specs. Call
3673 frame-update-face-colors to do that. */
3674 XSETFRAME (frame
, f
);
3675 call1 (Qframe_update_face_colors
, frame
);
3677 lface
= lface_from_face_name (f
, Qdefault
, 1);
3678 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3679 ? new_value
: Qunspecified
);
3680 realize_basic_faces (f
);
3682 if (EQ (param
, Qborder_color
))
3684 lface
= lface_from_face_name (f
, Qborder
, 1);
3685 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3686 ? new_value
: Qunspecified
);
3688 else if (EQ (param
, Qcursor_color
))
3690 lface
= lface_from_face_name (f
, Qcursor
, 1);
3691 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3692 ? new_value
: Qunspecified
);
3694 else if (EQ (param
, Qmouse_color
))
3696 lface
= lface_from_face_name (f
, Qmouse
, 1);
3697 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3698 ? new_value
: Qunspecified
);
3703 /* Get the value of X resource RESOURCE, class CLASS for the display
3704 of frame FRAME. This is here because ordinary `x-get-resource'
3705 doesn't take a frame argument. */
3707 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3708 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3709 (resource
, class, frame
)
3710 Lisp_Object resource
, class, frame
;
3713 CHECK_STRING (resource
, 0);
3714 CHECK_STRING (class, 1);
3715 CHECK_LIVE_FRAME (frame
, 2);
3717 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3718 resource
, class, Qnil
, Qnil
);
3724 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3725 If VALUE is "on" or "true", return t. If VALUE is "off" or
3726 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3727 error; if SIGNAL_P is zero, return 0. */
3730 face_boolean_x_resource_value (value
, signal_p
)
3734 Lisp_Object result
= make_number (0);
3736 xassert (STRINGP (value
));
3738 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3739 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3741 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3742 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3744 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3745 result
= Qunspecified
;
3747 signal_error ("Invalid face attribute value from X resource", value
);
3753 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3754 Finternal_set_lisp_face_attribute_from_resource
,
3755 Sinternal_set_lisp_face_attribute_from_resource
,
3757 (face
, attr
, value
, frame
)
3758 Lisp_Object face
, attr
, value
, frame
;
3760 CHECK_SYMBOL (face
, 0);
3761 CHECK_SYMBOL (attr
, 1);
3762 CHECK_STRING (value
, 2);
3764 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3765 value
= Qunspecified
;
3766 else if (EQ (attr
, QCheight
))
3768 value
= Fstring_to_number (value
, make_number (10));
3769 if (XINT (value
) <= 0)
3770 signal_error ("Invalid face height from X resource", value
);
3772 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3773 value
= face_boolean_x_resource_value (value
, 1);
3774 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3775 value
= intern (XSTRING (value
)->data
);
3776 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3777 value
= face_boolean_x_resource_value (value
, 1);
3778 else if (EQ (attr
, QCunderline
)
3779 || EQ (attr
, QCoverline
)
3780 || EQ (attr
, QCstrike_through
)
3781 || EQ (attr
, QCbox
))
3783 Lisp_Object boolean_value
;
3785 /* If the result of face_boolean_x_resource_value is t or nil,
3786 VALUE does NOT specify a color. */
3787 boolean_value
= face_boolean_x_resource_value (value
, 0);
3788 if (SYMBOLP (boolean_value
))
3789 value
= boolean_value
;
3792 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3797 /***********************************************************************
3799 ***********************************************************************/
3801 #ifdef USE_X_TOOLKIT
3803 /* Structure used to pass X resources to functions called via
3804 XtApplyToWidgets. */
3815 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3816 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3819 /* Set widget W's X resources from P which points to an x_resources
3820 structure. If W is a cascade button, apply resources to W's
3824 xm_apply_resources (w
, p
)
3829 struct x_resources
*res
= (struct x_resources
*) p
;
3831 XtSetValues (w
, res
->av
, res
->ac
);
3832 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3835 XtSetValues (submenu
, res
->av
, res
->ac
);
3836 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3841 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3842 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3845 1. Setting the XmNfontList resource leads to an infinite loop
3846 somewhere in LessTif. */
3849 xm_set_menu_resources_from_menu_face (f
, widget
)
3859 lface
= lface_from_face_name (f
, Qmenu
, 1);
3860 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3862 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3864 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3868 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3870 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3874 /* If any font-related attribute of `menu' is set, set the font. */
3876 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3877 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3878 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3879 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3880 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3882 #if 0 /* Setting the font leads to an infinite loop somewhere
3883 in LessTif during geometry computation. */
3885 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3886 fl
= XmFontListAppendEntry (NULL
, fe
);
3887 XtSetArg (av
[ac
], XmNfontList
, fl
);
3892 xassert (ac
<= sizeof av
/ sizeof *av
);
3896 struct x_resources res
;
3898 XtSetValues (widget
, av
, ac
);
3899 res
.av
= av
, res
.ac
= ac
;
3900 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3902 XmFontListFree (fl
);
3907 #endif /* USE_MOTIF */
3911 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3912 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3915 /* Set widget W's resources from P which points to an x_resources
3919 xl_apply_resources (widget
, p
)
3923 struct x_resources
*res
= (struct x_resources
*) p
;
3924 XtSetValues (widget
, res
->av
, res
->ac
);
3928 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3929 This is the Lucid version. */
3932 xl_set_menu_resources_from_menu_face (f
, widget
)
3941 lface
= lface_from_face_name (f
, Qmenu
, 1);
3942 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3944 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3946 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3950 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3952 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3957 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3958 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3959 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3960 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3961 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3963 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3969 struct x_resources res
;
3971 XtSetValues (widget
, av
, ac
);
3973 /* We must do children here in case we're handling a pop-up menu
3974 in which case WIDGET is a popup shell. XtApplyToWidgets
3975 is a function from lwlib. */
3976 res
.av
= av
, res
.ac
= ac
;
3977 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
3981 #endif /* USE_LUCID */
3984 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
3987 x_set_menu_resources_from_menu_face (f
, widget
)
3991 /* Realized faces may have been removed on frame F, e.g. because of
3992 face attribute changes. Recompute them, if necessary, since we
3993 will need the `menu' face. */
3994 if (f
->face_cache
->used
== 0)
3995 recompute_basic_faces (f
);
3998 xl_set_menu_resources_from_menu_face (f
, widget
);
4001 xm_set_menu_resources_from_menu_face (f
, widget
);
4005 #endif /* USE_X_TOOLKIT */
4007 #endif /* HAVE_X_WINDOWS */
4011 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4012 Sinternal_get_lisp_face_attribute
,
4014 "Return face attribute KEYWORD of face SYMBOL.\n\
4015 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4016 face attribute name, signal an error.\n\
4017 If the optional argument FRAME is given, report on face FACE in that\n\
4018 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4019 frames). If FRAME is omitted or nil, use the selected frame.")
4020 (symbol
, keyword
, frame
)
4021 Lisp_Object symbol
, keyword
, frame
;
4023 Lisp_Object lface
, value
= Qnil
;
4025 CHECK_SYMBOL (symbol
, 0);
4026 CHECK_SYMBOL (keyword
, 1);
4029 lface
= lface_from_face_name (NULL
, symbol
, 1);
4033 frame
= selected_frame
;
4034 CHECK_LIVE_FRAME (frame
, 2);
4035 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4038 if (EQ (keyword
, QCfamily
))
4039 value
= LFACE_FAMILY (lface
);
4040 else if (EQ (keyword
, QCheight
))
4041 value
= LFACE_HEIGHT (lface
);
4042 else if (EQ (keyword
, QCweight
))
4043 value
= LFACE_WEIGHT (lface
);
4044 else if (EQ (keyword
, QCslant
))
4045 value
= LFACE_SLANT (lface
);
4046 else if (EQ (keyword
, QCunderline
))
4047 value
= LFACE_UNDERLINE (lface
);
4048 else if (EQ (keyword
, QCoverline
))
4049 value
= LFACE_OVERLINE (lface
);
4050 else if (EQ (keyword
, QCstrike_through
))
4051 value
= LFACE_STRIKE_THROUGH (lface
);
4052 else if (EQ (keyword
, QCbox
))
4053 value
= LFACE_BOX (lface
);
4054 else if (EQ (keyword
, QCinverse_video
)
4055 || EQ (keyword
, QCreverse_video
))
4056 value
= LFACE_INVERSE (lface
);
4057 else if (EQ (keyword
, QCforeground
))
4058 value
= LFACE_FOREGROUND (lface
);
4059 else if (EQ (keyword
, QCbackground
))
4060 value
= LFACE_BACKGROUND (lface
);
4061 else if (EQ (keyword
, QCstipple
))
4062 value
= LFACE_STIPPLE (lface
);
4063 else if (EQ (keyword
, QCwidth
))
4064 value
= LFACE_SWIDTH (lface
);
4066 signal_error ("Invalid face attribute name", keyword
);
4072 DEFUN ("internal-lisp-face-attribute-values",
4073 Finternal_lisp_face_attribute_values
,
4074 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4075 "Return a list of valid discrete values for face attribute ATTR.\n\
4076 Value is nil if ATTR doesn't have a discrete set of valid values.")
4080 Lisp_Object result
= Qnil
;
4082 CHECK_SYMBOL (attr
, 0);
4084 if (EQ (attr
, QCweight
)
4085 || EQ (attr
, QCslant
)
4086 || EQ (attr
, QCwidth
))
4088 /* Extract permissible symbols from tables. */
4089 struct table_entry
*table
;
4092 if (EQ (attr
, QCweight
))
4093 table
= weight_table
, dim
= DIM (weight_table
);
4094 else if (EQ (attr
, QCslant
))
4095 table
= slant_table
, dim
= DIM (slant_table
);
4097 table
= swidth_table
, dim
= DIM (swidth_table
);
4099 for (i
= 0; i
< dim
; ++i
)
4101 Lisp_Object symbol
= *table
[i
].symbol
;
4102 Lisp_Object tail
= result
;
4105 && !EQ (XCAR (tail
), symbol
))
4109 result
= Fcons (symbol
, result
);
4112 else if (EQ (attr
, QCunderline
))
4113 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4114 else if (EQ (attr
, QCoverline
))
4115 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4116 else if (EQ (attr
, QCstrike_through
))
4117 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4118 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4119 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4125 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4126 Sinternal_merge_in_global_face
, 2, 2, 0,
4127 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4129 Lisp_Object face
, frame
;
4131 Lisp_Object global_lface
, local_lface
;
4132 CHECK_LIVE_FRAME (frame
, 1);
4133 global_lface
= lface_from_face_name (NULL
, face
, 1);
4134 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4135 if (NILP (local_lface
))
4136 local_lface
= Finternal_make_lisp_face (face
, frame
);
4137 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4138 XVECTOR (local_lface
)->contents
);
4143 /* The following function is implemented for compatibility with 20.2.
4144 The function is used in x-resolve-fonts when it is asked to
4145 return fonts with the same size as the font of a face. This is
4146 done in fontset.el. */
4148 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4149 "Return the font name of face FACE, or nil if it is unspecified.\n\
4150 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4151 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4152 The font default for a face is either nil, or a list\n\
4153 of the form (bold), (italic) or (bold italic).\n\
4154 If FRAME is omitted or nil, use the selected frame.")
4156 Lisp_Object face
, frame
;
4160 Lisp_Object result
= Qnil
;
4161 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4163 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4164 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4165 result
= Fcons (Qbold
, result
);
4167 if (!NILP (LFACE_SLANT (lface
))
4168 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4169 result
= Fcons (Qitalic
, result
);
4175 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4176 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4177 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4178 return build_string (face
->font_name
);
4183 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4184 all attributes are `equal'. Tries to be fast because this function
4185 is called quite often. */
4188 lface_equal_p (v1
, v2
)
4189 Lisp_Object
*v1
, *v2
;
4193 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4195 Lisp_Object a
= v1
[i
];
4196 Lisp_Object b
= v2
[i
];
4198 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4199 and the other is specified. */
4200 equal_p
= XTYPE (a
) == XTYPE (b
);
4209 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4210 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4211 XSTRING (a
)->size
) == 0);
4220 equal_p
= !NILP (Fequal (a
, b
));
4230 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4231 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4232 "True if FACE1 and FACE2 are equal.\n\
4233 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4234 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4235 If FRAME is omitted or nil, use the selected frame.")
4236 (face1
, face2
, frame
)
4237 Lisp_Object face1
, face2
, frame
;
4241 Lisp_Object lface1
, lface2
;
4246 /* Don't use check_x_frame here because this function is called
4247 before X frames exist. At that time, if FRAME is nil,
4248 selected_frame will be used which is the frame dumped with
4249 Emacs. That frame is not an X frame. */
4250 f
= frame_or_selected_frame (frame
, 2);
4252 lface1
= lface_from_face_name (NULL
, face1
, 1);
4253 lface2
= lface_from_face_name (NULL
, face2
, 1);
4254 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4255 XVECTOR (lface2
)->contents
);
4256 return equal_p
? Qt
: Qnil
;
4260 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4261 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4262 "True if FACE has no attribute specified.\n\
4263 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4264 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4265 If FRAME is omitted or nil, use the selected frame.")
4267 Lisp_Object face
, frame
;
4274 frame
= selected_frame
;
4275 CHECK_LIVE_FRAME (frame
, 0);
4279 lface
= lface_from_face_name (NULL
, face
, 1);
4281 lface
= lface_from_face_name (f
, face
, 1);
4283 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4284 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4287 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4291 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4293 "Return an alist of frame-local faces defined on FRAME.\n\
4294 For internal use only.")
4298 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4299 return f
->face_alist
;
4303 /* Return a hash code for Lisp string STRING with case ignored. Used
4304 below in computing a hash value for a Lisp face. */
4306 static INLINE
unsigned
4307 hash_string_case_insensitive (string
)
4312 xassert (STRINGP (string
));
4313 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4314 hash
= (hash
<< 1) ^ tolower (*s
);
4319 /* Return a hash code for face attribute vector V. */
4321 static INLINE
unsigned
4325 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4326 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4327 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4328 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4329 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4330 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4331 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4335 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4336 considering charsets/registries). They do if they specify the same
4337 family, point size, weight, width and slant. Both LFACE1 and
4338 LFACE2 must be fully-specified. */
4341 lface_same_font_attributes_p (lface1
, lface2
)
4342 Lisp_Object
*lface1
, *lface2
;
4344 xassert (lface_fully_specified_p (lface1
)
4345 && lface_fully_specified_p (lface2
));
4346 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4347 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4348 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4349 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4350 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4351 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4352 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4357 /***********************************************************************
4359 ***********************************************************************/
4361 /* Allocate and return a new realized face for Lisp face attribute
4362 vector ATTR, charset CHARSET, and registry REGISTRY. */
4364 static struct face
*
4365 make_realized_face (attr
, charset
, registry
)
4368 Lisp_Object registry
;
4370 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4371 bzero (face
, sizeof *face
);
4372 face
->charset
= charset
;
4373 face
->registry
= registry
;
4374 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4379 /* Free realized face FACE, including its X resources. FACE may
4383 free_realized_face (f
, face
)
4389 #ifdef HAVE_X_WINDOWS
4394 x_free_gc (f
, face
->gc
);
4398 free_face_colors (f
, face
);
4399 x_destroy_bitmap (f
, face
->stipple
);
4401 #endif /* HAVE_X_WINDOWS */
4408 /* Prepare face FACE for subsequent display on frame F. This
4409 allocated GCs if they haven't been allocated yet or have been freed
4410 by clearing the face cache. */
4413 prepare_face_for_display (f
, face
)
4417 #ifdef HAVE_X_WINDOWS
4418 xassert (FRAME_X_P (f
));
4423 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4425 xgcv
.foreground
= face
->foreground
;
4426 xgcv
.background
= face
->background
;
4427 xgcv
.graphics_exposures
= False
;
4429 /* The font of FACE may be null if we couldn't load it. */
4432 xgcv
.font
= face
->font
->fid
;
4439 xgcv
.fill_style
= FillOpaqueStippled
;
4440 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4441 mask
|= GCFillStyle
| GCStipple
;
4444 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4451 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4452 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4453 ISO8859-1 if the ASCII face suffices. */
4456 face_suitable_for_iso8859_1_p (face
)
4459 int len
= strlen (face
->font_name
);
4460 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4464 /* Value is non-zero if FACE is suitable for displaying characters
4465 of CHARSET. CHARSET < 0 means unibyte text. */
4468 face_suitable_for_charset_p (face
, charset
)
4476 if (EQ (face
->registry
, Vface_default_registry
)
4477 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4480 else if (face
->charset
== charset
)
4482 else if (face
->charset
== CHARSET_ASCII
4483 && charset
== charset_latin_iso8859_1
)
4484 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4485 else if (face
->charset
== charset_latin_iso8859_1
4486 && charset
== CHARSET_ASCII
)
4494 /***********************************************************************
4496 ***********************************************************************/
4498 /* Return a new face cache for frame F. */
4500 static struct face_cache
*
4504 struct face_cache
*c
;
4507 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4508 bzero (c
, sizeof *c
);
4509 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4510 c
->buckets
= (struct face
**) xmalloc (size
);
4511 bzero (c
->buckets
, size
);
4513 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4519 /* Clear out all graphics contexts for all realized faces, except for
4520 the basic faces. This should be done from time to time just to avoid
4521 keeping too many graphics contexts that are no longer needed. */
4525 struct face_cache
*c
;
4527 if (c
&& FRAME_X_P (c
->f
))
4529 #ifdef HAVE_X_WINDOWS
4531 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4533 struct face
*face
= c
->faces_by_id
[i
];
4534 if (face
&& face
->gc
)
4536 x_free_gc (c
->f
, face
->gc
);
4540 #endif /* HAVE_X_WINDOWS */
4545 /* Free all realized faces in face cache C, including basic faces. C
4546 may be null. If faces are freed, make sure the frame's current
4547 matrix is marked invalid, so that a display caused by an expose
4548 event doesn't try to use faces we destroyed. */
4551 free_realized_faces (c
)
4552 struct face_cache
*c
;
4557 struct frame
*f
= c
->f
;
4559 for (i
= 0; i
< c
->used
; ++i
)
4561 free_realized_face (f
, c
->faces_by_id
[i
]);
4562 c
->faces_by_id
[i
] = NULL
;
4566 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4567 bzero (c
->buckets
, size
);
4569 /* Must do a thorough redisplay the next time. Mark current
4570 matrices as invalid because they will reference faces freed
4571 above. This function is also called when a frame is
4572 destroyed. In this case, the root window of F is nil. */
4573 if (WINDOWP (f
->root_window
))
4575 clear_current_matrices (f
);
4576 ++windows_or_buffers_changed
;
4582 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4583 This is done after attributes of a named face have been changed,
4584 because we can't tell which realized faces depend on that face. */
4587 free_all_realized_faces (frame
)
4593 FOR_EACH_FRAME (rest
, frame
)
4594 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4597 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4601 /* Free face cache C and faces in it, including their X resources. */
4605 struct face_cache
*c
;
4609 free_realized_faces (c
);
4611 xfree (c
->faces_by_id
);
4617 /* Cache realized face FACE in face cache C. HASH is the hash value
4618 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4619 collision list of the face hash table of C. This is done because
4620 otherwise lookup_face would find FACE for every charset, even if
4621 faces with the same attributes but for specific charsets exist. */
4624 cache_face (c
, face
, hash
)
4625 struct face_cache
*c
;
4629 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4633 if (face
->fontset
>= 0)
4635 struct face
*last
= c
->buckets
[i
];
4646 c
->buckets
[i
] = face
;
4647 face
->prev
= face
->next
= NULL
;
4653 face
->next
= c
->buckets
[i
];
4655 face
->next
->prev
= face
;
4656 c
->buckets
[i
] = face
;
4659 /* Find a free slot in C->faces_by_id and use the index of the free
4660 slot as FACE->id. */
4661 for (i
= 0; i
< c
->used
; ++i
)
4662 if (c
->faces_by_id
[i
] == NULL
)
4666 /* Maybe enlarge C->faces_by_id. */
4667 if (i
== c
->used
&& c
->used
== c
->size
)
4669 int new_size
= 2 * c
->size
;
4670 int sz
= new_size
* sizeof *c
->faces_by_id
;
4671 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4676 /* Check that FACE got a unique id. */
4681 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4682 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4688 #endif /* GLYPH_DEBUG */
4690 c
->faces_by_id
[i
] = face
;
4696 /* Remove face FACE from cache C. */
4699 uncache_face (c
, face
)
4700 struct face_cache
*c
;
4703 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4706 face
->prev
->next
= face
->next
;
4708 c
->buckets
[i
] = face
->next
;
4711 face
->next
->prev
= face
->prev
;
4713 c
->faces_by_id
[face
->id
] = NULL
;
4714 if (face
->id
== c
->used
)
4719 /* Look up a realized face with face attributes ATTR in the face cache
4720 of frame F. The face will be used to display characters of
4721 CHARSET. CHARSET < 0 means the face will be used to display
4722 unibyte text. The value of face-default-registry is used to choose
4723 a font for the face in that case. Value is the ID of the face
4724 found. If no suitable face is found, realize a new one. */
4727 lookup_face (f
, attr
, charset
)
4732 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4737 xassert (c
!= NULL
);
4738 check_lface_attrs (attr
);
4740 /* Look up ATTR in the face cache. */
4741 hash
= lface_hash (attr
);
4742 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4744 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4745 if (face
->hash
== hash
4746 && (!FRAME_WINDOW_P (f
)
4747 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4748 && lface_equal_p (face
->lface
, attr
))
4751 /* If not found, realize a new face. */
4754 face
= realize_face (c
, attr
, charset
);
4755 cache_face (c
, face
, hash
);
4759 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4761 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4762 #endif /* GLYPH_DEBUG */
4768 /* Return the face id of the realized face for named face SYMBOL on
4769 frame F suitable for displaying characters from CHARSET. CHARSET <
4770 0 means unibyte text. */
4773 lookup_named_face (f
, symbol
, charset
)
4778 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4779 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4780 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4782 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4783 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4784 merge_face_vectors (symbol_attrs
, attrs
);
4785 return lookup_face (f
, attrs
, charset
);
4789 /* Return the ID of the realized ASCII face of Lisp face with ID
4790 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4793 ascii_face_of_lisp_face (f
, lface_id
)
4799 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4801 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4802 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4811 /* Return a face for charset ASCII that is like the face with id
4812 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4813 STEPS < 0 means larger. Value is the id of the face. */
4816 smaller_face (f
, face_id
, steps
)
4820 #ifdef HAVE_X_WINDOWS
4822 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4823 int pt
, last_pt
, last_height
;
4826 struct face
*new_face
;
4828 /* If not called for an X frame, just return the original face. */
4829 if (FRAME_TERMCAP_P (f
))
4832 /* Try in increments of 1/2 pt. */
4833 delta
= steps
< 0 ? 5 : -5;
4834 steps
= abs (steps
);
4836 face
= FACE_FROM_ID (f
, face_id
);
4837 bcopy (face
->lface
, attrs
, sizeof attrs
);
4838 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4839 new_face_id
= face_id
;
4840 last_height
= FONT_HEIGHT (face
->font
);
4844 /* Give up if we cannot find a font within 10pt. */
4845 && abs (last_pt
- pt
) < 100)
4847 /* Look up a face for a slightly smaller/larger font. */
4849 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4850 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4851 new_face
= FACE_FROM_ID (f
, new_face_id
);
4853 /* If height changes, count that as one step. */
4854 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4857 last_height
= FONT_HEIGHT (new_face
->font
);
4864 #else /* not HAVE_X_WINDOWS */
4868 #endif /* not HAVE_X_WINDOWS */
4872 /* Return a face for charset ASCII that is like the face with id
4873 FACE_ID on frame F, but has height HEIGHT. */
4876 face_with_height (f
, face_id
, height
)
4881 #ifdef HAVE_X_WINDOWS
4883 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4885 if (FRAME_TERMCAP_P (f
)
4889 face
= FACE_FROM_ID (f
, face_id
);
4890 bcopy (face
->lface
, attrs
, sizeof attrs
);
4891 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4892 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4893 #endif /* HAVE_X_WINDOWS */
4898 /* Return the face id of the realized face for named face SYMBOL on
4899 frame F suitable for displaying characters from CHARSET (CHARSET <
4900 0 means unibyte text), and use attributes of the face FACE_ID for
4901 attributes that aren't completely specified by SYMBOL. This is
4902 like lookup_named_face, except that the default attributes come
4903 from FACE_ID, not from the default face. FACE_ID is assumed to
4904 be already realized. */
4907 lookup_derived_face (f
, symbol
, charset
, face_id
)
4913 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4914 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4915 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4920 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4921 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4922 merge_face_vectors (symbol_attrs
, attrs
);
4923 return lookup_face (f
, attrs
, charset
);
4928 /***********************************************************************
4930 ***********************************************************************/
4932 DEFUN ("internal-set-font-selection-order",
4933 Finternal_set_font_selection_order
,
4934 Sinternal_set_font_selection_order
, 1, 1, 0,
4935 "Set font selection order for face font selection to ORDER.\n\
4936 ORDER must be a list of length 4 containing the symbols `:width',\n\
4937 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4938 first in ORDER are matched first, e.g. if `:height' appears before\n\
4939 `:weight' in ORDER, font selection first tries to find a font with\n\
4940 a suitable height, and then tries to match the font weight.\n\
4949 CHECK_LIST (order
, 0);
4950 bzero (indices
, sizeof indices
);
4954 CONSP (list
) && i
< DIM (indices
);
4955 list
= XCDR (list
), ++i
)
4957 Lisp_Object attr
= XCAR (list
);
4960 if (EQ (attr
, QCwidth
))
4962 else if (EQ (attr
, QCheight
))
4963 xlfd
= XLFD_POINT_SIZE
;
4964 else if (EQ (attr
, QCweight
))
4966 else if (EQ (attr
, QCslant
))
4971 if (indices
[i
] != 0)
4977 || i
!= DIM (indices
)
4982 signal_error ("Invalid font sort order", order
);
4984 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4986 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4987 free_all_realized_faces (Qnil
);
4994 DEFUN ("internal-set-alternative-font-family-alist",
4995 Finternal_set_alternative_font_family_alist
,
4996 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
4997 "Define alternative font families to try in face font selection.\n\
4998 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4999 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5000 be found. Value is ALIST.")
5004 CHECK_LIST (alist
, 0);
5005 Vface_alternative_font_family_alist
= alist
;
5006 free_all_realized_faces (Qnil
);
5011 #ifdef HAVE_X_WINDOWS
5013 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5014 Value is nil if not successful. */
5017 deduce_unibyte_registry (f
, font_name
)
5021 struct font_name font
;
5022 Lisp_Object registry
= Qnil
;
5024 font
.name
= STRDUPA (font_name
);
5025 if (split_font_name (f
, &font
, 0))
5029 /* Extract registry and encoding. */
5030 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5031 + strlen (font
.fields
[XLFD_ENCODING
])
5033 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5034 strcat (buffer
, "-");
5035 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5036 registry
= build_string (buffer
);
5043 /* Value is non-zero if FONT is the name of a scalable font. The
5044 X11R6 XLFD spec says that point size, pixel size, and average width
5045 are zero for scalable fonts. Intlfonts contain at least one
5046 scalable font ("*-muleindian-1") for which this isn't true, so we
5047 just test average width. */
5050 font_scalable_p (font
)
5051 struct font_name
*font
;
5053 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5054 return *s
== '0' && *(s
+ 1) == '\0';
5058 /* Value is non-zero if FONT1 is a better match for font attributes
5059 VALUES than FONT2. VALUES is an array of face attribute values in
5060 font sort order. COMPARE_PT_P zero means don't compare point
5064 better_font_p (values
, font1
, font2
, compare_pt_p
)
5066 struct font_name
*font1
, *font2
;
5071 for (i
= 0; i
< 4; ++i
)
5073 int xlfd_idx
= font_sort_order
[i
];
5075 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5077 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5078 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5080 if (delta1
> delta2
)
5082 else if (delta1
< delta2
)
5086 /* The difference may be equal because, e.g., the face
5087 specifies `italic' but we have only `regular' and
5088 `oblique'. Prefer `oblique' in this case. */
5089 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5090 && font1
->numeric
[xlfd_idx
] > values
[i
]
5091 && font2
->numeric
[xlfd_idx
] < values
[i
])
5103 /* Value is non-zero if FONT is an exact match for face attributes in
5104 SPECIFIED. SPECIFIED is an array of face attribute values in font
5108 exact_face_match_p (specified
, font
)
5110 struct font_name
*font
;
5114 for (i
= 0; i
< 4; ++i
)
5115 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5122 /* Value is the name of a scaled font, generated from scalable font
5123 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5124 Value is allocated from heap. */
5127 build_scalable_font_name (f
, font
, specified_pt
)
5129 struct font_name
*font
;
5132 char point_size
[20], pixel_size
[20];
5134 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5137 /* If scalable font is for a specific resolution, compute
5138 the point size we must specify from the resolution of
5139 the display and the specified resolution of the font. */
5140 if (font
->numeric
[XLFD_RESY
] != 0)
5142 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5143 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5148 pixel_value
= resy
/ 720.0 * pt
;
5151 /* Set point size of the font. */
5152 sprintf (point_size
, "%d", (int) pt
);
5153 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5154 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5156 /* Set pixel size. */
5157 sprintf (pixel_size
, "%d", pixel_value
);
5158 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5159 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5161 /* If font doesn't specify its resolution, use the
5162 resolution of the display. */
5163 if (font
->numeric
[XLFD_RESY
] == 0)
5166 sprintf (buffer
, "%d", (int) resy
);
5167 font
->fields
[XLFD_RESY
] = buffer
;
5168 font
->numeric
[XLFD_RESY
] = resy
;
5171 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5174 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5175 sprintf (buffer
, "%d", resx
);
5176 font
->fields
[XLFD_RESX
] = buffer
;
5177 font
->numeric
[XLFD_RESX
] = resx
;
5180 return build_font_name (font
);
5184 /* Value is non-zero if we are allowed to use scalable font FONT. We
5185 can't run a Lisp function here since this function may be called
5186 with input blocked. */
5189 may_use_scalable_font_p (font
, name
)
5190 struct font_name
*font
;
5193 if (EQ (Vscalable_fonts_allowed
, Qt
))
5195 else if (CONSP (Vscalable_fonts_allowed
))
5197 Lisp_Object tail
, regexp
;
5199 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5201 regexp
= XCAR (tail
);
5202 if (STRINGP (regexp
)
5203 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5211 #endif /* SCALABLE_FONTS != 0 */
5214 /* Return the name of the best matching font for face attributes
5215 ATTRS in the array of font_name structures FONTS which contains
5216 NFONTS elements. Value is a font name which is allocated from
5217 the heap. FONTS is freed by this function. */
5220 best_matching_font (f
, attrs
, fonts
, nfonts
)
5223 struct font_name
*fonts
;
5227 struct font_name
*best
;
5235 /* Make specified font attributes available in `specified',
5236 indexed by sort order. */
5237 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5239 int xlfd_idx
= font_sort_order
[i
];
5241 if (xlfd_idx
== XLFD_SWIDTH
)
5242 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5243 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5244 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5245 else if (xlfd_idx
== XLFD_WEIGHT
)
5246 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5247 else if (xlfd_idx
== XLFD_SLANT
)
5248 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5258 /* Start with the first non-scalable font in the list. */
5259 for (i
= 0; i
< nfonts
; ++i
)
5260 if (!font_scalable_p (fonts
+ i
))
5263 /* Find the best match among the non-scalable fonts. */
5268 for (i
= 1; i
< nfonts
; ++i
)
5269 if (!font_scalable_p (fonts
+ i
)
5270 && better_font_p (specified
, fonts
+ i
, best
, 1))
5274 exact_p
= exact_face_match_p (specified
, best
);
5283 /* Unless we found an exact match among non-scalable fonts, see if
5284 we can find a better match among scalable fonts. */
5287 /* A scalable font is better if
5289 1. its weight, slant, swidth attributes are better, or.
5291 2. the best non-scalable font doesn't have the required
5292 point size, and the scalable fonts weight, slant, swidth
5295 int non_scalable_has_exact_height_p
;
5297 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5298 non_scalable_has_exact_height_p
= 1;
5300 non_scalable_has_exact_height_p
= 0;
5302 for (i
= 0; i
< nfonts
; ++i
)
5303 if (font_scalable_p (fonts
+ i
))
5306 || better_font_p (specified
, fonts
+ i
, best
, 0)
5307 || (!non_scalable_has_exact_height_p
5308 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5313 if (font_scalable_p (best
))
5314 font_name
= build_scalable_font_name (f
, best
, pt
);
5316 font_name
= build_font_name (best
);
5318 #else /* !SCALABLE_FONTS */
5320 /* Find the best non-scalable font. */
5323 for (i
= 1; i
< nfonts
; ++i
)
5325 xassert (!font_scalable_p (fonts
+ i
));
5326 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5330 font_name
= build_font_name (best
);
5332 #endif /* !SCALABLE_FONTS */
5334 /* Free font_name structures. */
5335 free_font_names (fonts
, nfonts
);
5341 /* Try to get a list of fonts on frame F with font family FAMILY and
5342 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5343 of font_name structures for the fonts matched. Value is the number
5347 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5350 char *pattern
, *family
, *registry
;
5351 struct font_name
**fonts
;
5356 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5358 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5364 /* Try alternative font families from
5365 Vface_alternative_font_family_alist. */
5366 alter
= Fassoc (build_string (family
),
5367 Vface_alternative_font_family_alist
);
5369 for (alter
= XCDR (alter
);
5370 CONSP (alter
) && nfonts
== 0;
5371 alter
= XCDR (alter
))
5373 if (STRINGP (XCAR (alter
)))
5375 family
= LSTRDUPA (XCAR (alter
));
5376 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5380 /* Try font family of the default face or "fixed". */
5383 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5385 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5388 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5391 /* Try any family with the given registry. */
5393 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5400 /* Return the registry and encoding pattern that fonts for CHARSET
5401 should match. Value is allocated from the heap. */
5404 x_charset_registry (charset
)
5407 Lisp_Object prop
, charset_plist
;
5410 /* Get registry and encoding from the charset's plist. */
5411 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5412 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5416 if (index (XSTRING (prop
)->data
, '-'))
5417 registry
= xstrdup (XSTRING (prop
)->data
);
5420 /* If registry doesn't contain a `-', make it a pattern. */
5421 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5422 strcpy (registry
, XSTRING (prop
)->data
);
5423 strcat (registry
, "*-*");
5426 else if (STRINGP (Vface_default_registry
))
5427 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5429 registry
= xstrdup ("iso8859-1");
5435 /* Return the fontset id of the fontset name or alias name given by
5436 the family attribute of ATTRS on frame F. Value is -1 if the
5437 family attribute of ATTRS doesn't name a fontset. */
5440 face_fontset (f
, attrs
)
5444 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5447 name
= Fquery_fontset (name
, Qnil
);
5451 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5457 /* Get the font to use for the face realizing the fully-specified Lisp
5458 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5459 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5460 in this case. Value is the font name which is allocated from the
5461 heap (which means that it must be freed eventually). */
5464 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5468 Lisp_Object unibyte_registry
;
5470 struct font_name
*fonts
;
5474 /* ATTRS must be fully-specified. */
5475 xassert (lface_fully_specified_p (attrs
));
5477 if (STRINGP (unibyte_registry
))
5478 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5480 registry
= x_charset_registry (charset
);
5482 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5484 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5488 /* Choose a font to use on frame F to display CHARSET using FONTSET
5489 with Lisp face attributes specified by ATTRS. CHARSET may be any
5490 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
5491 unibyte text. If the fontset doesn't contain a font pattern for
5492 charset, use the pattern for CHARSET_ASCII. Value is the font name
5493 which is allocated from the heap and must be freed by the caller. */
5496 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5499 int fontset
, charset
;
5502 char *font_name
= NULL
;
5503 struct fontset_info
*fontset_info
;
5504 struct font_name
*fonts
;
5507 xassert (charset
!= CHARSET_COMPOSITION
);
5508 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5510 /* For unibyte text, use the ASCII font of the fontset. Using the
5511 ASCII font seems to be the most reasonable thing we can do in
5514 charset
= CHARSET_ASCII
;
5516 /* Get the font name pattern to use for CHARSET from the fontset. */
5517 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5518 pattern
= fontset_info
->fontname
[charset
];
5520 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5523 /* Get a list of fonts matching that pattern and choose the
5524 best match for the specified face attributes from it. */
5525 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5526 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5530 #endif /* HAVE_X_WINDOWS */
5534 /***********************************************************************
5536 ***********************************************************************/
5538 /* Realize basic faces on frame F. Value is zero if frame parameters
5539 of F don't contain enough information needed to realize the default
5543 realize_basic_faces (f
)
5548 if (realize_default_face (f
))
5550 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5551 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5552 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5553 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5554 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5555 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5556 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5557 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5558 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5566 /* Realize the default face on frame F. If the face is not fully
5567 specified, make it fully-specified. Attributes of the default face
5568 that are not explicitly specified are taken from frame parameters. */
5571 realize_default_face (f
)
5574 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5576 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5577 Lisp_Object unibyte_registry
;
5578 Lisp_Object frame_font
;
5582 /* If the `default' face is not yet known, create it. */
5583 lface
= lface_from_face_name (f
, Qdefault
, 0);
5587 XSETFRAME (frame
, f
);
5588 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5591 #ifdef HAVE_X_WINDOWS
5594 /* Set frame_font to the value of the `font' frame parameter. */
5595 frame_font
= Fassq (Qfont
, f
->param_alist
);
5596 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5597 frame_font
= XCDR (frame_font
);
5599 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5602 /* If frame_font is a fontset name, don't use that for
5603 determining font-related attributes of the default face
5604 because it is just an artificial name. Use the ASCII font of
5605 the fontset, instead. */
5606 struct font_info
*font_info
;
5607 struct font_name font
;
5610 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5614 /* Set weight etc. from the ASCII font. */
5615 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5618 /* Remember registry and encoding of the frame font. */
5619 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5620 if (STRINGP (unibyte_registry
))
5621 Vface_default_registry
= unibyte_registry
;
5623 Vface_default_registry
= build_string ("iso8859-1");
5625 /* But set the family to the fontset alias name. Implementation
5626 note: When a font is passed to Emacs via `-fn FONT', a
5627 fontset is created in `x-win.el' whose name ends in
5628 `fontset-startup'. This fontset has an alias name that is
5629 equal to frame_font. */
5630 xassert (STRINGP (frame_font
));
5631 font
.name
= LSTRDUPA (frame_font
);
5633 if (!split_font_name (f
, &font
, 1)
5634 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5635 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5636 LFACE_FAMILY (lface
) = frame_font
;
5640 /* Frame parameters contain a real font. Fill default face
5641 attributes from that font. */
5642 if (!set_lface_from_font_name (f
, lface
,
5643 XSTRING (frame_font
)->data
, 0, 0))
5646 /* Remember registry and encoding of the frame font. */
5648 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5649 if (STRINGP (unibyte_registry
))
5650 Vface_default_registry
= unibyte_registry
;
5652 Vface_default_registry
= build_string ("iso8859-1");
5655 #endif /* HAVE_X_WINDOWS */
5657 if (!FRAME_WINDOW_P (f
))
5659 LFACE_FAMILY (lface
) = build_string ("default");
5660 LFACE_SWIDTH (lface
) = Qnormal
;
5661 LFACE_HEIGHT (lface
) = make_number (1);
5662 LFACE_WEIGHT (lface
) = Qnormal
;
5663 LFACE_SLANT (lface
) = Qnormal
;
5666 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5667 LFACE_UNDERLINE (lface
) = Qnil
;
5669 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5670 LFACE_OVERLINE (lface
) = Qnil
;
5672 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5673 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5675 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5676 LFACE_BOX (lface
) = Qnil
;
5678 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5679 LFACE_INVERSE (lface
) = Qnil
;
5681 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5683 /* This function is called so early that colors are not yet
5684 set in the frame parameter list. */
5685 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5687 if (CONSP (color
) && STRINGP (XCDR (color
)))
5688 LFACE_FOREGROUND (lface
) = XCDR (color
);
5689 else if (FRAME_X_P (f
))
5691 else if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5695 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5697 /* This function is called so early that colors are not yet
5698 set in the frame parameter list. */
5699 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5700 if (CONSP (color
) && STRINGP (XCDR (color
)))
5701 LFACE_BACKGROUND (lface
) = XCDR (color
);
5702 else if (FRAME_X_P (f
))
5704 else if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5708 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5709 LFACE_STIPPLE (lface
) = Qnil
;
5711 /* Realize the face; it must be fully-specified now. */
5712 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5713 check_lface (lface
);
5714 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5715 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5717 /* Remove the former default face. */
5718 if (c
->used
> DEFAULT_FACE_ID
)
5720 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5721 uncache_face (c
, default_face
);
5722 free_realized_face (f
, default_face
);
5725 /* Insert the new default face. */
5726 cache_face (c
, face
, lface_hash (attrs
));
5727 xassert (face
->id
== DEFAULT_FACE_ID
);
5732 /* Realize basic faces other than the default face in face cache C.
5733 SYMBOL is the face name, ID is the face id the realized face must
5734 have. The default face must have been realized already. */
5737 realize_named_face (f
, symbol
, id
)
5742 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5743 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5744 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5745 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5746 struct face
*new_face
;
5748 /* The default face must exist and be fully specified. */
5749 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5750 check_lface_attrs (attrs
);
5751 xassert (lface_fully_specified_p (attrs
));
5753 /* If SYMBOL isn't know as a face, create it. */
5757 XSETFRAME (frame
, f
);
5758 lface
= Finternal_make_lisp_face (symbol
, frame
);
5761 /* Merge SYMBOL's face with the default face. */
5762 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5763 merge_face_vectors (symbol_attrs
, attrs
);
5765 /* Realize the face. */
5766 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5768 /* Remove the former face. */
5771 struct face
*old_face
= c
->faces_by_id
[id
];
5772 uncache_face (c
, old_face
);
5773 free_realized_face (f
, old_face
);
5776 /* Insert the new face. */
5777 cache_face (c
, new_face
, lface_hash (attrs
));
5778 xassert (new_face
->id
== id
);
5782 /* Realize the fully-specified face with attributes ATTRS in face
5783 cache C for character set CHARSET or for unibyte text if CHARSET <
5784 0. Value is a pointer to the newly created realized face. */
5786 static struct face
*
5787 realize_face (c
, attrs
, charset
)
5788 struct face_cache
*c
;
5794 /* LFACE must be fully specified. */
5795 xassert (c
!= NULL
);
5796 check_lface_attrs (attrs
);
5798 if (FRAME_X_P (c
->f
))
5799 face
= realize_x_face (c
, attrs
, charset
);
5800 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5801 face
= realize_tty_face (c
, attrs
, charset
);
5809 /* Realize the fully-specified face with attributes ATTRS in face
5810 cache C for character set CHARSET or for unibyte text if CHARSET <
5811 0. Do it for X frame C->f. Value is a pointer to the newly
5812 created realized face. */
5814 static struct face
*
5815 realize_x_face (c
, attrs
, charset
)
5816 struct face_cache
*c
;
5820 #ifdef HAVE_X_WINDOWS
5821 struct face
*face
, *default_face
;
5822 struct frame
*f
= c
->f
;
5823 Lisp_Object stipple
, overline
, strike_through
, box
;
5824 Lisp_Object unibyte_registry
;
5825 struct gcpro gcpro1
;
5827 xassert (FRAME_X_P (f
));
5829 /* If realizing a face for use in unibyte text, get the X registry
5830 and encoding to use from Vface_default_registry. */
5832 unibyte_registry
= (STRINGP (Vface_default_registry
)
5833 ? Vface_default_registry
5834 : build_string ("iso8859-1"));
5836 unibyte_registry
= Qnil
;
5837 GCPRO1 (unibyte_registry
);
5839 /* Allocate a new realized face. */
5840 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5842 /* Determine the font to use. Most of the time, the font will be
5843 the same as the font of the default face, so try that first. */
5844 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5846 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5847 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5849 face
->font
= default_face
->font
;
5850 face
->fontset
= default_face
->fontset
;
5851 face
->font_info_id
= default_face
->font_info_id
;
5852 face
->font_name
= default_face
->font_name
;
5853 face
->registry
= default_face
->registry
;
5855 else if (charset
>= 0)
5857 /* For all charsets except CHARSET_COMPOSITION, we use our own
5858 font selection functions to choose a best matching font for
5859 the specified face attributes. If the face specifies a
5860 fontset alias name, the fontset determines the font name
5861 pattern, otherwise we construct a font pattern from face
5862 attributes and charset.
5864 If charset is CHARSET_COMPOSITION, we always construct a face
5865 with a fontset, even if the face doesn't specify a fontset alias
5866 (we use fontset-standard in that case). When the composite
5867 character is displayed in xterm.c, a suitable concrete font is
5868 loaded in x_get_char_font_and_encoding. */
5870 char *font_name
= NULL
;
5871 int fontset
= face_fontset (f
, attrs
);
5873 if (charset
== CHARSET_COMPOSITION
)
5874 fontset
= max (0, fontset
);
5875 else if (fontset
< 0)
5876 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5879 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5883 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5888 /* Unibyte case, and font is not equal to that of the default
5889 face. UNIBYTE_REGISTRY is the X registry and encoding the
5890 font should have. What is a reasonable thing to do if the
5891 user specified a fontset alias name for the face in this
5892 case? We choose a font by taking the ASCII font of the
5893 fontset, but using UNIBYTE_REGISTRY for its registry and
5896 char *font_name
= NULL
;
5897 int fontset
= face_fontset (f
, attrs
);
5900 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5902 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5904 load_face_font_or_fontset (f
, face
, font_name
, -1);
5908 /* Load colors, and set remaining attributes. */
5910 load_face_colors (f
, face
, attrs
);
5913 box
= attrs
[LFACE_BOX_INDEX
];
5916 /* A simple box of line width 1 drawn in color given by
5918 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5920 face
->box
= FACE_SIMPLE_BOX
;
5921 face
->box_line_width
= 1;
5923 else if (INTEGERP (box
))
5925 /* Simple box of specified line width in foreground color of the
5927 xassert (XINT (box
) > 0);
5928 face
->box
= FACE_SIMPLE_BOX
;
5929 face
->box_line_width
= XFASTINT (box
);
5930 face
->box_color
= face
->foreground
;
5931 face
->box_color_defaulted_p
= 1;
5933 else if (CONSP (box
))
5935 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5936 being one of `raised' or `sunken'. */
5937 face
->box
= FACE_SIMPLE_BOX
;
5938 face
->box_color
= face
->foreground
;
5939 face
->box_color_defaulted_p
= 1;
5940 face
->box_line_width
= 1;
5944 Lisp_Object keyword
, value
;
5946 keyword
= XCAR (box
);
5954 if (EQ (keyword
, QCline_width
))
5956 if (INTEGERP (value
) && XINT (value
) > 0)
5957 face
->box_line_width
= XFASTINT (value
);
5959 else if (EQ (keyword
, QCcolor
))
5961 if (STRINGP (value
))
5963 face
->box_color
= load_color (f
, face
, value
,
5965 face
->use_box_color_for_shadows_p
= 1;
5968 else if (EQ (keyword
, QCstyle
))
5970 if (EQ (value
, Qreleased_button
))
5971 face
->box
= FACE_RAISED_BOX
;
5972 else if (EQ (value
, Qpressed_button
))
5973 face
->box
= FACE_SUNKEN_BOX
;
5978 /* Text underline, overline, strike-through. */
5980 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5982 /* Use default color (same as foreground color). */
5983 face
->underline_p
= 1;
5984 face
->underline_defaulted_p
= 1;
5985 face
->underline_color
= 0;
5987 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5989 /* Use specified color. */
5990 face
->underline_p
= 1;
5991 face
->underline_defaulted_p
= 0;
5992 face
->underline_color
5993 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5994 LFACE_UNDERLINE_INDEX
);
5996 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5998 face
->underline_p
= 0;
5999 face
->underline_defaulted_p
= 0;
6000 face
->underline_color
= 0;
6003 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6004 if (STRINGP (overline
))
6006 face
->overline_color
6007 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6008 LFACE_OVERLINE_INDEX
);
6009 face
->overline_p
= 1;
6011 else if (EQ (overline
, Qt
))
6013 face
->overline_color
= face
->foreground
;
6014 face
->overline_color_defaulted_p
= 1;
6015 face
->overline_p
= 1;
6018 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6019 if (STRINGP (strike_through
))
6021 face
->strike_through_color
6022 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6023 LFACE_STRIKE_THROUGH_INDEX
);
6024 face
->strike_through_p
= 1;
6026 else if (EQ (strike_through
, Qt
))
6028 face
->strike_through_color
= face
->foreground
;
6029 face
->strike_through_color_defaulted_p
= 1;
6030 face
->strike_through_p
= 1;
6033 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6034 if (!NILP (stipple
))
6035 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6038 xassert (face
->fontset
< 0 || face
->charset
== CHARSET_COMPOSITION
);
6039 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6041 #endif /* HAVE_X_WINDOWS */
6045 /* Realize the fully-specified face with attributes ATTRS in face
6046 cache C for character set CHARSET or for unibyte text if CHARSET <
6047 0. Do it for TTY frame C->f. Value is a pointer to the newly
6048 created realized face. */
6050 static struct face
*
6051 realize_tty_face (c
, attrs
, charset
)
6052 struct face_cache
*c
;
6059 Lisp_Object tty_color_alist
= Fsymbol_value (intern ("tty-color-alist"));
6060 int face_colors_defaulted
= 0;
6062 /* Frame must be a termcap frame. */
6063 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6065 /* Allocate a new realized face. */
6066 face
= make_realized_face (attrs
, charset
, Qnil
);
6067 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6069 /* Map face attributes to TTY appearances. We map slant to
6070 dimmed text because we want italic text to appear differently
6071 and because dimmed text is probably used infrequently. */
6072 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6073 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6075 if (weight
> XLFD_WEIGHT_MEDIUM
)
6076 face
->tty_bold_p
= 1;
6077 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6078 face
->tty_dim_p
= 1;
6079 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6080 face
->tty_underline_p
= 1;
6081 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6082 face
->tty_reverse_p
= 1;
6084 /* Map color names to color indices. */
6085 face
->foreground
= face
->background
= FACE_TTY_DEFAULT_COLOR
;
6087 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6089 && XSTRING (color
)->size
6090 && !NILP (tty_color_alist
)
6091 && (color
= Fassoc (color
, tty_color_alist
),
6093 /* Associations in tty-color-alist are of the form
6094 (NAME INDEX R G B). We need the INDEX part. */
6095 face
->foreground
= XINT (XCAR (XCDR (color
)));
6097 if (face
->foreground
== FACE_TTY_DEFAULT_COLOR
6098 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6100 face
->foreground
= load_color (c
->f
, face
,
6101 attrs
[LFACE_FOREGROUND_INDEX
],
6102 LFACE_FOREGROUND_INDEX
);
6104 /* If the foreground of the default face is the default color,
6105 use the foreground color defined by the frame. */
6106 if (FRAME_MSDOS_P (c
->f
) && face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6108 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6109 attrs
[LFACE_FOREGROUND_INDEX
] =
6110 msdos_stdcolor_name (face
->foreground
);
6111 face_colors_defaulted
= 1;
6116 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6118 && XSTRING (color
)->size
6119 && !NILP (tty_color_alist
)
6120 && (color
= Fassoc (color
, tty_color_alist
),
6122 /* Associations in tty-color-alist are of the form
6123 (NAME INDEX R G B). We need the INDEX part. */
6124 face
->background
= XINT (XCAR (XCDR (color
)));
6126 if (face
->background
== FACE_TTY_DEFAULT_COLOR
6127 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6129 face
->background
= load_color (c
->f
, face
,
6130 attrs
[LFACE_BACKGROUND_INDEX
],
6131 LFACE_BACKGROUND_INDEX
);
6133 /* If the background of the default face is the default color,
6134 use the background color defined by the frame. */
6135 if (FRAME_MSDOS_P (c
->f
) && face
->background
== FACE_TTY_DEFAULT_COLOR
)
6137 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6138 attrs
[LFACE_BACKGROUND_INDEX
] =
6139 msdos_stdcolor_name (face
->background
);
6140 face_colors_defaulted
= 1;
6145 /* Swap colors if face is inverse-video. If the colors are taken
6146 from the frame colors, they are already inverted, since the
6147 frame-creation function calls x-handle-reverse-video. */
6148 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6150 unsigned long tem
= face
->foreground
;
6152 face
->foreground
= face
->background
;
6153 face
->background
= tem
;
6161 /***********************************************************************
6163 ***********************************************************************/
6165 /* Return the ID of the face to use to display character CH with face
6166 property PROP on frame F in current_buffer. */
6169 compute_char_face (f
, ch
, prop
)
6175 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6177 : CHAR_CHARSET (ch
));
6180 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6183 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6184 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6185 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6186 merge_face_vector_with_property (f
, attrs
, prop
);
6187 face_id
= lookup_face (f
, attrs
, charset
);
6194 /* Return the face ID associated with buffer position POS for
6195 displaying ASCII characters. Return in *ENDPTR the position at
6196 which a different face is needed, as far as text properties and
6197 overlays are concerned. W is a window displaying current_buffer.
6199 REGION_BEG, REGION_END delimit the region, so it can be
6202 LIMIT is a position not to scan beyond. That is to limit the time
6203 this function can take.
6205 If MOUSE is non-zero, use the character's mouse-face, not its face.
6207 The face returned is suitable for displaying CHARSET_ASCII if
6208 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6209 the face is suitable for displaying unibyte text. */
6212 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6213 endptr
, limit
, mouse
)
6216 int region_beg
, region_end
;
6221 struct frame
*f
= XFRAME (w
->frame
);
6222 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6223 Lisp_Object prop
, position
;
6225 Lisp_Object
*overlay_vec
;
6228 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6229 Lisp_Object limit1
, end
;
6230 struct face
*default_face
;
6231 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6233 /* W must display the current buffer. We could write this function
6234 to use the frame and buffer of W, but right now it doesn't. */
6235 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6237 XSETFRAME (frame
, f
);
6238 XSETFASTINT (position
, pos
);
6241 if (pos
< region_beg
&& region_beg
< endpos
)
6242 endpos
= region_beg
;
6244 /* Get the `face' or `mouse_face' text property at POS, and
6245 determine the next position at which the property changes. */
6246 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6247 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6248 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6250 endpos
= XINT (end
);
6252 /* Look at properties from overlays. */
6257 /* First try with room for 40 overlays. */
6259 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6260 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6261 &next_overlay
, NULL
);
6263 /* If there are more than 40, make enough space for all, and try
6265 if (noverlays
> len
)
6268 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6269 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6270 &next_overlay
, NULL
);
6273 if (next_overlay
< endpos
)
6274 endpos
= next_overlay
;
6279 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6281 /* Optimize common cases where we can use the default face. */
6284 && !(pos
>= region_beg
&& pos
< region_end
)
6286 || !FRAME_WINDOW_P (f
)
6287 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6288 return DEFAULT_FACE_ID
;
6290 /* Begin with attributes from the default face. */
6291 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6293 /* Merge in attributes specified via text properties. */
6295 merge_face_vector_with_property (f
, attrs
, prop
);
6297 /* Now merge the overlay data. */
6298 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6299 for (i
= 0; i
< noverlays
; i
++)
6304 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6306 merge_face_vector_with_property (f
, attrs
, prop
);
6308 oend
= OVERLAY_END (overlay_vec
[i
]);
6309 oendpos
= OVERLAY_POSITION (oend
);
6310 if (oendpos
< endpos
)
6314 /* If in the region, merge in the region face. */
6315 if (pos
>= region_beg
&& pos
< region_end
)
6317 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6318 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6320 if (region_end
< endpos
)
6321 endpos
= region_end
;
6326 /* Look up a realized face with the given face attributes,
6327 or realize a new one. Charset is ignored for tty frames. */
6328 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6332 /* Compute the face at character position POS in Lisp string STRING on
6333 window W, for charset CHARSET_ASCII.
6335 If STRING is an overlay string, it comes from position BUFPOS in
6336 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6337 not an overlay string. W must display the current buffer.
6338 REGION_BEG and REGION_END give the start and end positions of the
6339 region; both are -1 if no region is visible. BASE_FACE_ID is the
6340 id of the basic face to merge with. It is usually equal to
6341 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6342 for strings displayed in the mode or top line.
6344 Set *ENDPTR to the next position where to check for faces in
6345 STRING; -1 if the face is constant from POS to the end of the
6348 Value is the id of the face to use. The face returned is suitable
6349 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6350 the face is suitable for displaying unibyte text. */
6353 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6354 region_end
, endptr
, base_face_id
)
6358 int region_beg
, region_end
;
6360 enum face_id base_face_id
;
6362 Lisp_Object prop
, position
, end
, limit
;
6363 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6364 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6365 struct face
*base_face
;
6366 int multibyte_p
= STRING_MULTIBYTE (string
);
6368 /* Get the value of the face property at the current position within
6369 STRING. Value is nil if there is no face property. */
6370 XSETFASTINT (position
, pos
);
6371 prop
= Fget_text_property (position
, Qface
, string
);
6373 /* Get the next position at which to check for faces. Value of end
6374 is nil if face is constant all the way to the end of the string.
6375 Otherwise it is a string position where to check faces next.
6376 Limit is the maximum position up to which to check for property
6377 changes in Fnext_single_property_change. Strings are usually
6378 short, so set the limit to the end of the string. */
6379 XSETFASTINT (limit
, XSTRING (string
)->size
);
6380 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6382 *endptr
= XFASTINT (end
);
6386 base_face
= FACE_FROM_ID (f
, base_face_id
);
6387 xassert (base_face
);
6389 /* Optimize the default case that there is no face property and we
6390 are not in the region. */
6392 && (base_face_id
!= DEFAULT_FACE_ID
6393 /* BUFPOS <= 0 means STRING is not an overlay string, so
6394 that the region doesn't have to be taken into account. */
6396 || bufpos
< region_beg
6397 || bufpos
>= region_end
)
6399 /* We can't realize faces for different charsets differently
6400 if we don't have fonts, so we can stop here if not working
6401 on a window-system frame. */
6402 || !FRAME_WINDOW_P (f
)
6403 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6404 return base_face
->id
;
6406 /* Begin with attributes from the base face. */
6407 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6409 /* Merge in attributes specified via text properties. */
6411 merge_face_vector_with_property (f
, attrs
, prop
);
6413 /* If in the region, merge in the region face. */
6415 && bufpos
>= region_beg
6416 && bufpos
< region_end
)
6418 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6419 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6422 /* Look up a realized face with the given face attributes,
6423 or realize a new one. */
6424 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6429 /***********************************************************************
6431 ***********************************************************************/
6435 /* Print the contents of the realized face FACE to stderr. */
6438 dump_realized_face (face
)
6441 fprintf (stderr
, "ID: %d\n", face
->id
);
6442 #ifdef HAVE_X_WINDOWS
6443 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6445 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6447 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6448 fprintf (stderr
, "background: 0x%lx (%s)\n",
6450 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6451 fprintf (stderr
, "font_name: %s (%s)\n",
6453 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6454 #ifdef HAVE_X_WINDOWS
6455 fprintf (stderr
, "font = %p\n", face
->font
);
6457 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6458 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6459 fprintf (stderr
, "underline: %d (%s)\n",
6461 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6462 fprintf (stderr
, "hash: %d\n", face
->hash
);
6463 fprintf (stderr
, "charset: %d\n", face
->charset
);
6467 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6475 fprintf (stderr
, "font selection order: ");
6476 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6477 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6478 fprintf (stderr
, "\n");
6480 fprintf (stderr
, "alternative fonts: ");
6481 debug_print (Vface_alternative_font_family_alist
);
6482 fprintf (stderr
, "\n");
6484 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6485 Fdump_face (make_number (i
));
6490 CHECK_NUMBER (n
, 0);
6491 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6493 error ("Not a valid face");
6494 dump_realized_face (face
);
6501 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6505 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6506 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6507 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6511 #endif /* GLYPH_DEBUG != 0 */
6515 /***********************************************************************
6517 ***********************************************************************/
6522 Qface
= intern ("face");
6524 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6525 staticpro (&Qbitmap_spec_p
);
6526 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6527 staticpro (&Qframe_update_face_colors
);
6529 /* Lisp face attribute keywords. */
6530 QCfamily
= intern (":family");
6531 staticpro (&QCfamily
);
6532 QCheight
= intern (":height");
6533 staticpro (&QCheight
);
6534 QCweight
= intern (":weight");
6535 staticpro (&QCweight
);
6536 QCslant
= intern (":slant");
6537 staticpro (&QCslant
);
6538 QCunderline
= intern (":underline");
6539 staticpro (&QCunderline
);
6540 QCinverse_video
= intern (":inverse-video");
6541 staticpro (&QCinverse_video
);
6542 QCreverse_video
= intern (":reverse-video");
6543 staticpro (&QCreverse_video
);
6544 QCforeground
= intern (":foreground");
6545 staticpro (&QCforeground
);
6546 QCbackground
= intern (":background");
6547 staticpro (&QCbackground
);
6548 QCstipple
= intern (":stipple");;
6549 staticpro (&QCstipple
);
6550 QCwidth
= intern (":width");
6551 staticpro (&QCwidth
);
6552 QCfont
= intern (":font");
6553 staticpro (&QCfont
);
6554 QCbold
= intern (":bold");
6555 staticpro (&QCbold
);
6556 QCitalic
= intern (":italic");
6557 staticpro (&QCitalic
);
6558 QCoverline
= intern (":overline");
6559 staticpro (&QCoverline
);
6560 QCstrike_through
= intern (":strike-through");
6561 staticpro (&QCstrike_through
);
6562 QCbox
= intern (":box");
6565 /* Symbols used for Lisp face attribute values. */
6566 QCcolor
= intern (":color");
6567 staticpro (&QCcolor
);
6568 QCline_width
= intern (":line-width");
6569 staticpro (&QCline_width
);
6570 QCstyle
= intern (":style");
6571 staticpro (&QCstyle
);
6572 Qreleased_button
= intern ("released-button");
6573 staticpro (&Qreleased_button
);
6574 Qpressed_button
= intern ("pressed-button");
6575 staticpro (&Qpressed_button
);
6576 Qnormal
= intern ("normal");
6577 staticpro (&Qnormal
);
6578 Qultra_light
= intern ("ultra-light");
6579 staticpro (&Qultra_light
);
6580 Qextra_light
= intern ("extra-light");
6581 staticpro (&Qextra_light
);
6582 Qlight
= intern ("light");
6583 staticpro (&Qlight
);
6584 Qsemi_light
= intern ("semi-light");
6585 staticpro (&Qsemi_light
);
6586 Qsemi_bold
= intern ("semi-bold");
6587 staticpro (&Qsemi_bold
);
6588 Qbold
= intern ("bold");
6590 Qextra_bold
= intern ("extra-bold");
6591 staticpro (&Qextra_bold
);
6592 Qultra_bold
= intern ("ultra-bold");
6593 staticpro (&Qultra_bold
);
6594 Qoblique
= intern ("oblique");
6595 staticpro (&Qoblique
);
6596 Qitalic
= intern ("italic");
6597 staticpro (&Qitalic
);
6598 Qreverse_oblique
= intern ("reverse-oblique");
6599 staticpro (&Qreverse_oblique
);
6600 Qreverse_italic
= intern ("reverse-italic");
6601 staticpro (&Qreverse_italic
);
6602 Qultra_condensed
= intern ("ultra-condensed");
6603 staticpro (&Qultra_condensed
);
6604 Qextra_condensed
= intern ("extra-condensed");
6605 staticpro (&Qextra_condensed
);
6606 Qcondensed
= intern ("condensed");
6607 staticpro (&Qcondensed
);
6608 Qsemi_condensed
= intern ("semi-condensed");
6609 staticpro (&Qsemi_condensed
);
6610 Qsemi_expanded
= intern ("semi-expanded");
6611 staticpro (&Qsemi_expanded
);
6612 Qexpanded
= intern ("expanded");
6613 staticpro (&Qexpanded
);
6614 Qextra_expanded
= intern ("extra-expanded");
6615 staticpro (&Qextra_expanded
);
6616 Qultra_expanded
= intern ("ultra-expanded");
6617 staticpro (&Qultra_expanded
);
6618 Qbackground_color
= intern ("background-color");
6619 staticpro (&Qbackground_color
);
6620 Qforeground_color
= intern ("foreground-color");
6621 staticpro (&Qforeground_color
);
6622 Qunspecified
= intern ("unspecified");
6623 staticpro (&Qunspecified
);
6625 Qx_charset_registry
= intern ("x-charset-registry");
6626 staticpro (&Qx_charset_registry
);
6627 Qface_alias
= intern ("face-alias");
6628 staticpro (&Qface_alias
);
6629 Qdefault
= intern ("default");
6630 staticpro (&Qdefault
);
6631 Qtool_bar
= intern ("tool-bar");
6632 staticpro (&Qtool_bar
);
6633 Qregion
= intern ("region");
6634 staticpro (&Qregion
);
6635 Qfringe
= intern ("fringe");
6636 staticpro (&Qfringe
);
6637 Qheader_line
= intern ("header-line");
6638 staticpro (&Qheader_line
);
6639 Qscroll_bar
= intern ("scroll-bar");
6640 staticpro (&Qscroll_bar
);
6641 Qmenu
= intern ("menu");
6643 Qcursor
= intern ("cursor");
6644 staticpro (&Qcursor
);
6645 Qborder
= intern ("border");
6646 staticpro (&Qborder
);
6647 Qmouse
= intern ("mouse");
6648 staticpro (&Qmouse
);
6649 Qtty_color_desc
= intern ("tty-color-desc");
6650 staticpro (&Qtty_color_desc
);
6651 Qtty_color_by_index
= intern ("tty-color-by-index");
6652 staticpro (&Qtty_color_by_index
);
6654 defsubr (&Sinternal_make_lisp_face
);
6655 defsubr (&Sinternal_lisp_face_p
);
6656 defsubr (&Sinternal_set_lisp_face_attribute
);
6657 #ifdef HAVE_X_WINDOWS
6658 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6659 defsubr (&Sface_color_gray_p
);
6660 defsubr (&Sface_color_supported_p
);
6662 defsubr (&Sinternal_get_lisp_face_attribute
);
6663 defsubr (&Sinternal_lisp_face_attribute_values
);
6664 defsubr (&Sinternal_lisp_face_equal_p
);
6665 defsubr (&Sinternal_lisp_face_empty_p
);
6666 defsubr (&Sinternal_copy_lisp_face
);
6667 defsubr (&Sinternal_merge_in_global_face
);
6668 defsubr (&Sface_font
);
6669 defsubr (&Sframe_face_alist
);
6670 defsubr (&Sinternal_set_font_selection_order
);
6671 defsubr (&Sinternal_set_alternative_font_family_alist
);
6673 defsubr (&Sdump_face
);
6674 defsubr (&Sshow_face_resources
);
6675 #endif /* GLYPH_DEBUG */
6676 defsubr (&Sclear_face_cache
);
6678 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6679 "*Limit for font matching.\n\
6680 If an integer > 0, font matching functions won't load more than\n\
6681 that number of fonts when searching for a matching font.");
6682 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6684 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6685 "List of global face definitions (for internal use only.)");
6686 Vface_new_frame_defaults
= Qnil
;
6688 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6689 "*Default stipple pattern used on monochrome displays.\n\
6690 This stipple pattern is used on monochrome displays\n\
6691 instead of shades of gray for a face background color.\n\
6692 See `set-face-stipple' for possible values for this variable.");
6693 Vface_default_stipple
= build_string ("gray3");
6695 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6696 "Default registry and encoding to use.\n\
6697 This registry and encoding is used for unibyte text. It is set up\n\
6698 from the specified frame font when Emacs starts. (For internal use only.)");
6699 Vface_default_registry
= Qnil
;
6701 DEFVAR_LISP ("face-alternative-font-family-alist",
6702 &Vface_alternative_font_family_alist
, "");
6703 Vface_alternative_font_family_alist
= Qnil
;
6707 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6708 "Allowed scalable fonts.\n\
6709 A value of nil means don't allow any scalable fonts.\n\
6710 A value of t means allow any scalable font.\n\
6711 Otherwise, value must be a list of regular expressions. A font may be\n\
6712 scaled if its name matches a regular expression in the list.");
6713 Vscalable_fonts_allowed
= Qnil
;
6715 #endif /* SCALABLE_FONTS */
6717 #ifdef HAVE_X_WINDOWS
6718 defsubr (&Sbitmap_spec_p
);
6719 defsubr (&Sx_list_fonts
);
6720 defsubr (&Sinternal_face_x_get_resource
);
6721 defsubr (&Sx_family_fonts
);
6722 defsubr (&Sx_font_family_list
);
6723 #endif /* HAVE_X_WINDOWS */