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
)
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);
2813 /* If FONT_NAME is completely bogus try to use something reasonable
2814 if this function must succeed. Otherwise, give up. */
2819 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2821 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2823 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2825 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2827 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2829 || first_font_matching (f
, "fixed", &font
))
2830 free_font_name_p
= 1;
2836 /* Set attributes only if unspecified, otherwise face defaults for
2837 new frames would never take effect. */
2839 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2841 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2842 + strlen (font
.fields
[XLFD_FOUNDRY
])
2844 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2845 font
.fields
[XLFD_FAMILY
]);
2846 LFACE_FAMILY (lface
) = build_string (buffer
);
2849 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2851 pt
= xlfd_point_size (f
, &font
);
2853 LFACE_HEIGHT (lface
) = make_number (pt
);
2856 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2857 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2859 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2860 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2862 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2863 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2865 if (free_font_name_p
)
2871 #endif /* HAVE_X_WINDOWS */
2874 /* Merge two Lisp face attribute vectors FROM and TO and store the
2875 resulting attributes in TO. Every non-nil attribute of FROM
2876 overrides the corresponding attribute of TO. */
2879 merge_face_vectors (from
, to
)
2880 Lisp_Object
*from
, *to
;
2883 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2884 if (!UNSPECIFIEDP (from
[i
]))
2889 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2890 is a face property, determine the resulting face attributes on
2891 frame F, and store them in TO. PROP may be a single face
2892 specification or a list of such specifications. Each face
2893 specification can be
2895 1. A symbol or string naming a Lisp face.
2897 2. A property list of the form (KEYWORD VALUE ...) where each
2898 KEYWORD is a face attribute name, and value is an appropriate value
2901 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2902 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2903 for compatibility with 20.2.
2905 Face specifications earlier in lists take precedence over later
2909 merge_face_vector_with_property (f
, to
, prop
)
2916 Lisp_Object first
= XCAR (prop
);
2918 if (EQ (first
, Qforeground_color
)
2919 || EQ (first
, Qbackground_color
))
2921 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2922 . COLOR). COLOR must be a string. */
2923 Lisp_Object color_name
= XCDR (prop
);
2924 Lisp_Object color
= first
;
2926 if (STRINGP (color_name
))
2928 if (EQ (color
, Qforeground_color
))
2929 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2931 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2934 add_to_log ("Invalid face color", color_name
, Qnil
);
2936 else if (SYMBOLP (first
)
2937 && *XSYMBOL (first
)->name
->data
== ':')
2939 /* Assume this is the property list form. */
2940 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2942 Lisp_Object keyword
= XCAR (prop
);
2943 Lisp_Object value
= XCAR (XCDR (prop
));
2945 if (EQ (keyword
, QCfamily
))
2947 if (STRINGP (value
))
2948 to
[LFACE_FAMILY_INDEX
] = value
;
2950 add_to_log ("Illegal face font family", value
, Qnil
);
2952 else if (EQ (keyword
, QCheight
))
2954 if (INTEGERP (value
))
2955 to
[LFACE_HEIGHT_INDEX
] = value
;
2957 add_to_log ("Illegal face font height", value
, Qnil
);
2959 else if (EQ (keyword
, QCweight
))
2962 && face_numeric_weight (value
) >= 0)
2963 to
[LFACE_WEIGHT_INDEX
] = value
;
2965 add_to_log ("Illegal face weight", value
, Qnil
);
2967 else if (EQ (keyword
, QCslant
))
2970 && face_numeric_slant (value
) >= 0)
2971 to
[LFACE_SLANT_INDEX
] = value
;
2973 add_to_log ("Illegal face slant", value
, Qnil
);
2975 else if (EQ (keyword
, QCunderline
))
2980 to
[LFACE_UNDERLINE_INDEX
] = value
;
2982 add_to_log ("Illegal face underline", value
, Qnil
);
2984 else if (EQ (keyword
, QCoverline
))
2989 to
[LFACE_OVERLINE_INDEX
] = value
;
2991 add_to_log ("Illegal face overline", value
, Qnil
);
2993 else if (EQ (keyword
, QCstrike_through
))
2998 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3000 add_to_log ("Illegal face strike-through", value
, Qnil
);
3002 else if (EQ (keyword
, QCbox
))
3005 value
= make_number (1);
3006 if (INTEGERP (value
)
3010 to
[LFACE_BOX_INDEX
] = value
;
3012 add_to_log ("Illegal face box", value
, Qnil
);
3014 else if (EQ (keyword
, QCinverse_video
)
3015 || EQ (keyword
, QCreverse_video
))
3017 if (EQ (value
, Qt
) || NILP (value
))
3018 to
[LFACE_INVERSE_INDEX
] = value
;
3020 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3022 else if (EQ (keyword
, QCforeground
))
3024 if (STRINGP (value
))
3025 to
[LFACE_FOREGROUND_INDEX
] = value
;
3027 add_to_log ("Illegal face foreground", value
, Qnil
);
3029 else if (EQ (keyword
, QCbackground
))
3031 if (STRINGP (value
))
3032 to
[LFACE_BACKGROUND_INDEX
] = value
;
3034 add_to_log ("Illegal face background", value
, Qnil
);
3036 else if (EQ (keyword
, QCstipple
))
3038 #ifdef HAVE_X_WINDOWS
3039 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3040 if (!NILP (pixmap_p
))
3041 to
[LFACE_STIPPLE_INDEX
] = value
;
3043 add_to_log ("Illegal face stipple", value
, Qnil
);
3046 else if (EQ (keyword
, QCwidth
))
3049 && face_numeric_swidth (value
) >= 0)
3050 to
[LFACE_SWIDTH_INDEX
] = value
;
3052 add_to_log ("Illegal face width", value
, Qnil
);
3055 add_to_log ("Invalid attribute %s in face property",
3058 prop
= XCDR (XCDR (prop
));
3063 /* This is a list of face specs. Specifications at the
3064 beginning of the list take precedence over later
3065 specifications, so we have to merge starting with the
3066 last specification. */
3067 Lisp_Object next
= XCDR (prop
);
3069 merge_face_vector_with_property (f
, to
, next
);
3070 merge_face_vector_with_property (f
, to
, first
);
3075 /* PROP ought to be a face name. */
3076 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3078 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3080 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3085 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3086 Sinternal_make_lisp_face
, 1, 2, 0,
3087 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3088 If FACE was not known as a face before, create a new one.\n\
3089 If optional argument FRAME is specified, make a frame-local face\n\
3090 for that frame. Otherwise operate on the global face definition.\n\
3091 Value is a vector of face attributes.")
3093 Lisp_Object face
, frame
;
3095 Lisp_Object global_lface
, lface
;
3099 CHECK_SYMBOL (face
, 0);
3100 global_lface
= lface_from_face_name (NULL
, face
, 0);
3104 CHECK_LIVE_FRAME (frame
, 1);
3106 lface
= lface_from_face_name (f
, face
, 0);
3109 f
= NULL
, lface
= Qnil
;
3111 /* Add a global definition if there is none. */
3112 if (NILP (global_lface
))
3114 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3116 XVECTOR (global_lface
)->contents
[0] = Qface
;
3117 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3118 Vface_new_frame_defaults
);
3120 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3121 face id to Lisp face is given by the vector lface_id_to_name.
3122 The mapping from Lisp face to Lisp face id is given by the
3123 property `face' of the Lisp face name. */
3124 if (next_lface_id
== lface_id_to_name_size
)
3126 int new_size
= max (50, 2 * lface_id_to_name_size
);
3127 int sz
= new_size
* sizeof *lface_id_to_name
;
3128 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3129 lface_id_to_name_size
= new_size
;
3132 lface_id_to_name
[next_lface_id
] = face
;
3133 Fput (face
, Qface
, make_number (next_lface_id
));
3137 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3138 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3140 /* Add a frame-local definition. */
3145 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3147 XVECTOR (lface
)->contents
[0] = Qface
;
3148 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3151 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3152 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3155 lface
= global_lface
;
3157 xassert (LFACEP (lface
));
3158 check_lface (lface
);
3163 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3164 Sinternal_lisp_face_p
, 1, 2, 0,
3165 "Return non-nil if FACE names a face.\n\
3166 If optional second parameter FRAME is non-nil, check for the\n\
3167 existence of a frame-local face with name FACE on that frame.\n\
3168 Otherwise check for the existence of a global face.")
3170 Lisp_Object face
, frame
;
3176 CHECK_LIVE_FRAME (frame
, 1);
3177 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3180 lface
= lface_from_face_name (NULL
, face
, 0);
3186 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3187 Sinternal_copy_lisp_face
, 4, 4, 0,
3188 "Copy face FROM to TO.\n\
3189 If FRAME it t, copy the global face definition of FROM to the\n\
3190 global face definition of TO. Otherwise, copy the frame-local\n\
3191 definition of FROM on FRAME to the frame-local definition of TO\n\
3192 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3195 (from
, to
, frame
, new_frame
)
3196 Lisp_Object from
, to
, frame
, new_frame
;
3198 Lisp_Object lface
, copy
;
3200 CHECK_SYMBOL (from
, 0);
3201 CHECK_SYMBOL (to
, 1);
3202 if (NILP (new_frame
))
3207 /* Copy global definition of FROM. We don't make copies of
3208 strings etc. because 20.2 didn't do it either. */
3209 lface
= lface_from_face_name (NULL
, from
, 1);
3210 copy
= Finternal_make_lisp_face (to
, Qnil
);
3214 /* Copy frame-local definition of FROM. */
3215 CHECK_LIVE_FRAME (frame
, 2);
3216 CHECK_LIVE_FRAME (new_frame
, 3);
3217 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3218 copy
= Finternal_make_lisp_face (to
, new_frame
);
3221 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3222 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3228 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3229 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3230 "Set attribute ATTR of FACE to VALUE.\n\
3231 If optional argument FRAME is given, set the face attribute of face FACE\n\
3232 on that frame. If FRAME is t, set the attribute of the default for face\n\
3233 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3235 (face
, attr
, value
, frame
)
3236 Lisp_Object face
, attr
, value
, frame
;
3239 Lisp_Object old_value
= Qnil
;
3240 int font_related_attr_p
= 0;
3242 CHECK_SYMBOL (face
, 0);
3243 CHECK_SYMBOL (attr
, 1);
3245 face
= resolve_face_name (face
);
3247 /* Set lface to the Lisp attribute vector of FACE. */
3249 lface
= lface_from_face_name (NULL
, face
, 1);
3253 frame
= selected_frame
;
3255 CHECK_LIVE_FRAME (frame
, 3);
3256 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3258 /* If a frame-local face doesn't exist yet, create one. */
3260 lface
= Finternal_make_lisp_face (face
, frame
);
3263 if (EQ (attr
, QCfamily
))
3265 if (!UNSPECIFIEDP (value
))
3267 CHECK_STRING (value
, 3);
3268 if (XSTRING (value
)->size
== 0)
3269 signal_error ("Invalid face family", value
);
3271 old_value
= LFACE_FAMILY (lface
);
3272 LFACE_FAMILY (lface
) = value
;
3273 font_related_attr_p
= 1;
3275 else if (EQ (attr
, QCheight
))
3277 if (!UNSPECIFIEDP (value
))
3279 CHECK_NUMBER (value
, 3);
3280 if (XINT (value
) <= 0)
3281 signal_error ("Invalid face height", value
);
3283 old_value
= LFACE_HEIGHT (lface
);
3284 LFACE_HEIGHT (lface
) = value
;
3285 font_related_attr_p
= 1;
3287 else if (EQ (attr
, QCweight
))
3289 if (!UNSPECIFIEDP (value
))
3291 CHECK_SYMBOL (value
, 3);
3292 if (face_numeric_weight (value
) < 0)
3293 signal_error ("Invalid face weight", value
);
3295 old_value
= LFACE_WEIGHT (lface
);
3296 LFACE_WEIGHT (lface
) = value
;
3297 font_related_attr_p
= 1;
3299 else if (EQ (attr
, QCslant
))
3301 if (!UNSPECIFIEDP (value
))
3303 CHECK_SYMBOL (value
, 3);
3304 if (face_numeric_slant (value
) < 0)
3305 signal_error ("Invalid face slant", value
);
3307 old_value
= LFACE_SLANT (lface
);
3308 LFACE_SLANT (lface
) = value
;
3309 font_related_attr_p
= 1;
3311 else if (EQ (attr
, QCunderline
))
3313 if (!UNSPECIFIEDP (value
))
3314 if ((SYMBOLP (value
)
3316 && !EQ (value
, Qnil
))
3317 /* Underline color. */
3319 && XSTRING (value
)->size
== 0))
3320 signal_error ("Invalid face underline", value
);
3322 old_value
= LFACE_UNDERLINE (lface
);
3323 LFACE_UNDERLINE (lface
) = value
;
3325 else if (EQ (attr
, QCoverline
))
3327 if (!UNSPECIFIEDP (value
))
3328 if ((SYMBOLP (value
)
3330 && !EQ (value
, Qnil
))
3331 /* Overline color. */
3333 && XSTRING (value
)->size
== 0))
3334 signal_error ("Invalid face overline", value
);
3336 old_value
= LFACE_OVERLINE (lface
);
3337 LFACE_OVERLINE (lface
) = value
;
3339 else if (EQ (attr
, QCstrike_through
))
3341 if (!UNSPECIFIEDP (value
))
3342 if ((SYMBOLP (value
)
3344 && !EQ (value
, Qnil
))
3345 /* Strike-through color. */
3347 && XSTRING (value
)->size
== 0))
3348 signal_error ("Invalid face strike-through", value
);
3350 old_value
= LFACE_STRIKE_THROUGH (lface
);
3351 LFACE_STRIKE_THROUGH (lface
) = value
;
3353 else if (EQ (attr
, QCbox
))
3357 /* Allow t meaning a simple box of width 1 in foreground color
3360 value
= make_number (1);
3362 if (UNSPECIFIEDP (value
))
3364 else if (NILP (value
))
3366 else if (INTEGERP (value
))
3367 valid_p
= XINT (value
) > 0;
3368 else if (STRINGP (value
))
3369 valid_p
= XSTRING (value
)->size
> 0;
3370 else if (CONSP (value
))
3386 if (EQ (k
, QCline_width
))
3388 if (!INTEGERP (v
) || XINT (v
) <= 0)
3391 else if (EQ (k
, QCcolor
))
3393 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3396 else if (EQ (k
, QCstyle
))
3398 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3405 valid_p
= NILP (tem
);
3411 signal_error ("Invalid face box", value
);
3413 old_value
= LFACE_BOX (lface
);
3414 LFACE_BOX (lface
) = value
;
3416 else if (EQ (attr
, QCinverse_video
)
3417 || EQ (attr
, QCreverse_video
))
3419 if (!UNSPECIFIEDP (value
))
3421 CHECK_SYMBOL (value
, 3);
3422 if (!EQ (value
, Qt
) && !NILP (value
))
3423 signal_error ("Invalid inverse-video face attribute value", value
);
3425 old_value
= LFACE_INVERSE (lface
);
3426 LFACE_INVERSE (lface
) = value
;
3428 else if (EQ (attr
, QCforeground
))
3430 if (!UNSPECIFIEDP (value
))
3432 /* Don't check for valid color names here because it depends
3433 on the frame (display) whether the color will be valid
3434 when the face is realized. */
3435 CHECK_STRING (value
, 3);
3436 if (XSTRING (value
)->size
== 0)
3437 signal_error ("Empty foreground color value", value
);
3439 old_value
= LFACE_FOREGROUND (lface
);
3440 LFACE_FOREGROUND (lface
) = value
;
3442 else if (EQ (attr
, QCbackground
))
3444 if (!UNSPECIFIEDP (value
))
3446 /* Don't check for valid color names here because it depends
3447 on the frame (display) whether the color will be valid
3448 when the face is realized. */
3449 CHECK_STRING (value
, 3);
3450 if (XSTRING (value
)->size
== 0)
3451 signal_error ("Empty background color value", value
);
3453 old_value
= LFACE_BACKGROUND (lface
);
3454 LFACE_BACKGROUND (lface
) = value
;
3456 else if (EQ (attr
, QCstipple
))
3458 #ifdef HAVE_X_WINDOWS
3459 if (!UNSPECIFIEDP (value
)
3461 && NILP (Fbitmap_spec_p (value
)))
3462 signal_error ("Invalid stipple attribute", value
);
3463 old_value
= LFACE_STIPPLE (lface
);
3464 LFACE_STIPPLE (lface
) = value
;
3465 #endif /* HAVE_X_WINDOWS */
3467 else if (EQ (attr
, QCwidth
))
3469 if (!UNSPECIFIEDP (value
))
3471 CHECK_SYMBOL (value
, 3);
3472 if (face_numeric_swidth (value
) < 0)
3473 signal_error ("Invalid face width", value
);
3475 old_value
= LFACE_SWIDTH (lface
);
3476 LFACE_SWIDTH (lface
) = value
;
3477 font_related_attr_p
= 1;
3479 else if (EQ (attr
, QCfont
))
3481 #ifdef HAVE_X_WINDOWS
3482 /* Set font-related attributes of the Lisp face from an
3486 CHECK_STRING (value
, 3);
3488 f
= SELECTED_FRAME ();
3490 f
= check_x_frame (frame
);
3492 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3493 signal_error ("Invalid font name", value
);
3495 font_related_attr_p
= 1;
3496 #endif /* HAVE_X_WINDOWS */
3498 else if (EQ (attr
, QCbold
))
3500 old_value
= LFACE_WEIGHT (lface
);
3501 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3502 font_related_attr_p
= 1;
3504 else if (EQ (attr
, QCitalic
))
3506 old_value
= LFACE_SLANT (lface
);
3507 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3508 font_related_attr_p
= 1;
3511 signal_error ("Invalid face attribute name", attr
);
3513 /* Changing a named face means that all realized faces depending on
3514 that face are invalid. Since we cannot tell which realized faces
3515 depend on the face, make sure they are all removed. This is done
3516 by incrementing face_change_count. The next call to
3517 init_iterator will then free realized faces. */
3519 && (EQ (attr
, QCfont
)
3520 || NILP (Fequal (old_value
, value
))))
3522 ++face_change_count
;
3523 ++windows_or_buffers_changed
;
3526 #ifdef HAVE_X_WINDOWS
3529 && !UNSPECIFIEDP (value
)
3530 && NILP (Fequal (old_value
, value
)))
3536 if (EQ (face
, Qdefault
))
3538 /* Changed font-related attributes of the `default' face are
3539 reflected in changed `font' frame parameters. */
3540 if (font_related_attr_p
3541 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3542 set_font_frame_param (frame
, lface
);
3543 else if (EQ (attr
, QCforeground
))
3544 param
= Qforeground_color
;
3545 else if (EQ (attr
, QCbackground
))
3546 param
= Qbackground_color
;
3548 else if (EQ (face
, Qscroll_bar
))
3550 /* Changing the colors of `scroll-bar' sets frame parameters
3551 `scroll-bar-foreground' and `scroll-bar-background'. */
3552 if (EQ (attr
, QCforeground
))
3553 param
= Qscroll_bar_foreground
;
3554 else if (EQ (attr
, QCbackground
))
3555 param
= Qscroll_bar_background
;
3557 else if (EQ (face
, Qborder
))
3559 /* Changing background color of `border' sets frame parameter
3561 if (EQ (attr
, QCbackground
))
3562 param
= Qborder_color
;
3564 else if (EQ (face
, Qcursor
))
3566 /* Changing background color of `cursor' sets frame parameter
3568 if (EQ (attr
, QCbackground
))
3569 param
= Qcursor_color
;
3571 else if (EQ (face
, Qmouse
))
3573 /* Changing background color of `mouse' sets frame parameter
3575 if (EQ (attr
, QCbackground
))
3576 param
= Qmouse_color
;
3579 if (SYMBOLP (param
))
3580 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3583 #endif /* HAVE_X_WINDOWS */
3589 #ifdef HAVE_X_WINDOWS
3591 /* Set the `font' frame parameter of FRAME according to `default' face
3592 attributes LFACE. */
3595 set_font_frame_param (frame
, lface
)
3596 Lisp_Object frame
, lface
;
3598 struct frame
*f
= XFRAME (frame
);
3599 Lisp_Object frame_font
;
3603 /* Get FRAME's font parameter. */
3604 frame_font
= Fassq (Qfont
, f
->param_alist
);
3605 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3606 frame_font
= XCDR (frame_font
);
3608 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3611 /* Frame parameter is a fontset name. Modify the fontset so
3612 that all its fonts reflect face attributes LFACE. */
3614 struct fontset_info
*fontset_info
;
3616 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3618 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3619 if (fontset_info
->fontname
[charset
])
3621 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3623 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3624 build_string (font
), frame
);
3630 /* Frame parameter is an X font name. I believe this can
3631 only happen in unibyte mode. */
3632 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3633 -1, Vface_default_registry
);
3636 store_frame_param (f
, Qfont
, build_string (font
));
3643 /* Update the corresponding face when frame parameter PARAM on frame F
3644 has been assigned the value NEW_VALUE. */
3647 update_face_from_frame_parameter (f
, param
, new_value
)
3649 Lisp_Object param
, new_value
;
3653 /* If there are no faces yet, give up. This is the case when called
3654 from Fx_create_frame, and we do the necessary things later in
3655 face-set-after-frame-defaults. */
3656 if (NILP (f
->face_alist
))
3659 if (EQ (param
, Qforeground_color
))
3661 lface
= lface_from_face_name (f
, Qdefault
, 1);
3662 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3663 ? new_value
: Qunspecified
);
3664 realize_basic_faces (f
);
3666 else if (EQ (param
, Qbackground_color
))
3670 /* Changing the background color might change the background
3671 mode, so that we have to load new defface specs. Call
3672 frame-update-face-colors to do that. */
3673 XSETFRAME (frame
, f
);
3674 call1 (Qframe_update_face_colors
, frame
);
3676 lface
= lface_from_face_name (f
, Qdefault
, 1);
3677 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3678 ? new_value
: Qunspecified
);
3679 realize_basic_faces (f
);
3681 if (EQ (param
, Qborder_color
))
3683 lface
= lface_from_face_name (f
, Qborder
, 1);
3684 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3685 ? new_value
: Qunspecified
);
3687 else if (EQ (param
, Qcursor_color
))
3689 lface
= lface_from_face_name (f
, Qcursor
, 1);
3690 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3691 ? new_value
: Qunspecified
);
3693 else if (EQ (param
, Qmouse_color
))
3695 lface
= lface_from_face_name (f
, Qmouse
, 1);
3696 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3697 ? new_value
: Qunspecified
);
3702 /* Get the value of X resource RESOURCE, class CLASS for the display
3703 of frame FRAME. This is here because ordinary `x-get-resource'
3704 doesn't take a frame argument. */
3706 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3707 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3708 (resource
, class, frame
)
3709 Lisp_Object resource
, class, frame
;
3712 CHECK_STRING (resource
, 0);
3713 CHECK_STRING (class, 1);
3714 CHECK_LIVE_FRAME (frame
, 2);
3716 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3717 resource
, class, Qnil
, Qnil
);
3723 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3724 If VALUE is "on" or "true", return t. If VALUE is "off" or
3725 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3726 error; if SIGNAL_P is zero, return 0. */
3729 face_boolean_x_resource_value (value
, signal_p
)
3733 Lisp_Object result
= make_number (0);
3735 xassert (STRINGP (value
));
3737 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3738 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3740 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3741 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3743 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3744 result
= Qunspecified
;
3746 signal_error ("Invalid face attribute value from X resource", value
);
3752 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3753 Finternal_set_lisp_face_attribute_from_resource
,
3754 Sinternal_set_lisp_face_attribute_from_resource
,
3756 (face
, attr
, value
, frame
)
3757 Lisp_Object face
, attr
, value
, frame
;
3759 CHECK_SYMBOL (face
, 0);
3760 CHECK_SYMBOL (attr
, 1);
3761 CHECK_STRING (value
, 2);
3763 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3764 value
= Qunspecified
;
3765 else if (EQ (attr
, QCheight
))
3767 value
= Fstring_to_number (value
, make_number (10));
3768 if (XINT (value
) <= 0)
3769 signal_error ("Invalid face height from X resource", value
);
3771 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3772 value
= face_boolean_x_resource_value (value
, 1);
3773 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3774 value
= intern (XSTRING (value
)->data
);
3775 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3776 value
= face_boolean_x_resource_value (value
, 1);
3777 else if (EQ (attr
, QCunderline
)
3778 || EQ (attr
, QCoverline
)
3779 || EQ (attr
, QCstrike_through
)
3780 || EQ (attr
, QCbox
))
3782 Lisp_Object boolean_value
;
3784 /* If the result of face_boolean_x_resource_value is t or nil,
3785 VALUE does NOT specify a color. */
3786 boolean_value
= face_boolean_x_resource_value (value
, 0);
3787 if (SYMBOLP (boolean_value
))
3788 value
= boolean_value
;
3791 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3796 /***********************************************************************
3798 ***********************************************************************/
3800 #ifdef USE_X_TOOLKIT
3802 /* Structure used to pass X resources to functions called via
3803 XtApplyToWidgets. */
3814 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3815 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3818 /* Set widget W's X resources from P which points to an x_resources
3819 structure. If W is a cascade button, apply resources to W's
3823 xm_apply_resources (w
, p
)
3828 struct x_resources
*res
= (struct x_resources
*) p
;
3830 XtSetValues (w
, res
->av
, res
->ac
);
3831 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3834 XtSetValues (submenu
, res
->av
, res
->ac
);
3835 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3840 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3841 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3844 1. Setting the XmNfontList resource leads to an infinite loop
3845 somewhere in LessTif. */
3848 xm_set_menu_resources_from_menu_face (f
, widget
)
3858 lface
= lface_from_face_name (f
, Qmenu
, 1);
3859 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3861 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3863 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3867 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3869 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3873 /* If any font-related attribute of `menu' is set, set the font. */
3875 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3876 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3877 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3878 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3879 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3881 #if 0 /* Setting the font leads to an infinite loop somewhere
3882 in LessTif during geometry computation. */
3884 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3885 fl
= XmFontListAppendEntry (NULL
, fe
);
3886 XtSetArg (av
[ac
], XmNfontList
, fl
);
3891 xassert (ac
<= sizeof av
/ sizeof *av
);
3895 struct x_resources res
;
3897 XtSetValues (widget
, av
, ac
);
3898 res
.av
= av
, res
.ac
= ac
;
3899 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3901 XmFontListFree (fl
);
3906 #endif /* USE_MOTIF */
3910 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3911 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3914 /* Set widget W's resources from P which points to an x_resources
3918 xl_apply_resources (widget
, p
)
3922 struct x_resources
*res
= (struct x_resources
*) p
;
3923 XtSetValues (widget
, res
->av
, res
->ac
);
3927 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3928 This is the Lucid version. */
3931 xl_set_menu_resources_from_menu_face (f
, widget
)
3940 lface
= lface_from_face_name (f
, Qmenu
, 1);
3941 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3943 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3945 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3949 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3951 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3956 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3957 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3958 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3959 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3960 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3962 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3968 struct x_resources res
;
3970 XtSetValues (widget
, av
, ac
);
3972 /* We must do children here in case we're handling a pop-up menu
3973 in which case WIDGET is a popup shell. XtApplyToWidgets
3974 is a function from lwlib. */
3975 res
.av
= av
, res
.ac
= ac
;
3976 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
3980 #endif /* USE_LUCID */
3983 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
3986 x_set_menu_resources_from_menu_face (f
, widget
)
3991 xl_set_menu_resources_from_menu_face (f
, widget
);
3994 xm_set_menu_resources_from_menu_face (f
, widget
);
3998 #endif /* USE_X_TOOLKIT */
4000 #endif /* HAVE_X_WINDOWS */
4004 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4005 Sinternal_get_lisp_face_attribute
,
4007 "Return face attribute KEYWORD of face SYMBOL.\n\
4008 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4009 face attribute name, signal an error.\n\
4010 If the optional argument FRAME is given, report on face FACE in that\n\
4011 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4012 frames). If FRAME is omitted or nil, use the selected frame.")
4013 (symbol
, keyword
, frame
)
4014 Lisp_Object symbol
, keyword
, frame
;
4016 Lisp_Object lface
, value
= Qnil
;
4018 CHECK_SYMBOL (symbol
, 0);
4019 CHECK_SYMBOL (keyword
, 1);
4022 lface
= lface_from_face_name (NULL
, symbol
, 1);
4026 frame
= selected_frame
;
4027 CHECK_LIVE_FRAME (frame
, 2);
4028 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4031 if (EQ (keyword
, QCfamily
))
4032 value
= LFACE_FAMILY (lface
);
4033 else if (EQ (keyword
, QCheight
))
4034 value
= LFACE_HEIGHT (lface
);
4035 else if (EQ (keyword
, QCweight
))
4036 value
= LFACE_WEIGHT (lface
);
4037 else if (EQ (keyword
, QCslant
))
4038 value
= LFACE_SLANT (lface
);
4039 else if (EQ (keyword
, QCunderline
))
4040 value
= LFACE_UNDERLINE (lface
);
4041 else if (EQ (keyword
, QCoverline
))
4042 value
= LFACE_OVERLINE (lface
);
4043 else if (EQ (keyword
, QCstrike_through
))
4044 value
= LFACE_STRIKE_THROUGH (lface
);
4045 else if (EQ (keyword
, QCbox
))
4046 value
= LFACE_BOX (lface
);
4047 else if (EQ (keyword
, QCinverse_video
)
4048 || EQ (keyword
, QCreverse_video
))
4049 value
= LFACE_INVERSE (lface
);
4050 else if (EQ (keyword
, QCforeground
))
4051 value
= LFACE_FOREGROUND (lface
);
4052 else if (EQ (keyword
, QCbackground
))
4053 value
= LFACE_BACKGROUND (lface
);
4054 else if (EQ (keyword
, QCstipple
))
4055 value
= LFACE_STIPPLE (lface
);
4056 else if (EQ (keyword
, QCwidth
))
4057 value
= LFACE_SWIDTH (lface
);
4059 signal_error ("Invalid face attribute name", keyword
);
4065 DEFUN ("internal-lisp-face-attribute-values",
4066 Finternal_lisp_face_attribute_values
,
4067 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4068 "Return a list of valid discrete values for face attribute ATTR.\n\
4069 Value is nil if ATTR doesn't have a discrete set of valid values.")
4073 Lisp_Object result
= Qnil
;
4075 CHECK_SYMBOL (attr
, 0);
4077 if (EQ (attr
, QCweight
)
4078 || EQ (attr
, QCslant
)
4079 || EQ (attr
, QCwidth
))
4081 /* Extract permissible symbols from tables. */
4082 struct table_entry
*table
;
4085 if (EQ (attr
, QCweight
))
4086 table
= weight_table
, dim
= DIM (weight_table
);
4087 else if (EQ (attr
, QCslant
))
4088 table
= slant_table
, dim
= DIM (slant_table
);
4090 table
= swidth_table
, dim
= DIM (swidth_table
);
4092 for (i
= 0; i
< dim
; ++i
)
4094 Lisp_Object symbol
= *table
[i
].symbol
;
4095 Lisp_Object tail
= result
;
4098 && !EQ (XCAR (tail
), symbol
))
4102 result
= Fcons (symbol
, result
);
4105 else if (EQ (attr
, QCunderline
))
4106 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4107 else if (EQ (attr
, QCoverline
))
4108 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4109 else if (EQ (attr
, QCstrike_through
))
4110 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4111 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4112 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4118 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4119 Sinternal_merge_in_global_face
, 2, 2, 0,
4120 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4122 Lisp_Object face
, frame
;
4124 Lisp_Object global_lface
, local_lface
;
4125 CHECK_LIVE_FRAME (frame
, 1);
4126 global_lface
= lface_from_face_name (NULL
, face
, 1);
4127 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4128 if (NILP (local_lface
))
4129 local_lface
= Finternal_make_lisp_face (face
, frame
);
4130 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4131 XVECTOR (local_lface
)->contents
);
4136 /* The following function is implemented for compatibility with 20.2.
4137 The function is used in x-resolve-fonts when it is asked to
4138 return fonts with the same size as the font of a face. This is
4139 done in fontset.el. */
4141 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4142 "Return the font name of face FACE, or nil if it is unspecified.\n\
4143 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4144 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4145 The font default for a face is either nil, or a list\n\
4146 of the form (bold), (italic) or (bold italic).\n\
4147 If FRAME is omitted or nil, use the selected frame.")
4149 Lisp_Object face
, frame
;
4153 Lisp_Object result
= Qnil
;
4154 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4156 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4157 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4158 result
= Fcons (Qbold
, result
);
4160 if (!NILP (LFACE_SLANT (lface
))
4161 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4162 result
= Fcons (Qitalic
, result
);
4168 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4169 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4170 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4171 return build_string (face
->font_name
);
4176 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4177 all attributes are `equal'. Tries to be fast because this function
4178 is called quite often. */
4181 lface_equal_p (v1
, v2
)
4182 Lisp_Object
*v1
, *v2
;
4186 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4188 Lisp_Object a
= v1
[i
];
4189 Lisp_Object b
= v2
[i
];
4191 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4192 and the other is specified. */
4193 equal_p
= XTYPE (a
) == XTYPE (b
);
4202 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4203 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4204 XSTRING (a
)->size
) == 0);
4213 equal_p
= !NILP (Fequal (a
, b
));
4223 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4224 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4225 "True if FACE1 and FACE2 are equal.\n\
4226 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4227 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4228 If FRAME is omitted or nil, use the selected frame.")
4229 (face1
, face2
, frame
)
4230 Lisp_Object face1
, face2
, frame
;
4234 Lisp_Object lface1
, lface2
;
4239 /* Don't use check_x_frame here because this function is called
4240 before X frames exist. At that time, if FRAME is nil,
4241 selected_frame will be used which is the frame dumped with
4242 Emacs. That frame is not an X frame. */
4243 f
= frame_or_selected_frame (frame
, 2);
4245 lface1
= lface_from_face_name (NULL
, face1
, 1);
4246 lface2
= lface_from_face_name (NULL
, face2
, 1);
4247 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4248 XVECTOR (lface2
)->contents
);
4249 return equal_p
? Qt
: Qnil
;
4253 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4254 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4255 "True if FACE has no attribute specified.\n\
4256 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4257 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4258 If FRAME is omitted or nil, use the selected frame.")
4260 Lisp_Object face
, frame
;
4267 frame
= selected_frame
;
4268 CHECK_LIVE_FRAME (frame
, 0);
4272 lface
= lface_from_face_name (NULL
, face
, 1);
4274 lface
= lface_from_face_name (f
, face
, 1);
4276 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4277 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4280 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4284 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4286 "Return an alist of frame-local faces defined on FRAME.\n\
4287 For internal use only.")
4291 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4292 return f
->face_alist
;
4296 /* Return a hash code for Lisp string STRING with case ignored. Used
4297 below in computing a hash value for a Lisp face. */
4299 static INLINE
unsigned
4300 hash_string_case_insensitive (string
)
4305 xassert (STRINGP (string
));
4306 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4307 hash
= (hash
<< 1) ^ tolower (*s
);
4312 /* Return a hash code for face attribute vector V. */
4314 static INLINE
unsigned
4318 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4319 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4320 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4321 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4322 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4323 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4324 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4328 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4329 considering charsets/registries). They do if they specify the same
4330 family, point size, weight, width and slant. Both LFACE1 and
4331 LFACE2 must be fully-specified. */
4334 lface_same_font_attributes_p (lface1
, lface2
)
4335 Lisp_Object
*lface1
, *lface2
;
4337 xassert (lface_fully_specified_p (lface1
)
4338 && lface_fully_specified_p (lface2
));
4339 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4340 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4341 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4342 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4343 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4344 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4345 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4350 /***********************************************************************
4352 ***********************************************************************/
4354 /* Allocate and return a new realized face for Lisp face attribute
4355 vector ATTR, charset CHARSET, and registry REGISTRY. */
4357 static struct face
*
4358 make_realized_face (attr
, charset
, registry
)
4361 Lisp_Object registry
;
4363 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4364 bzero (face
, sizeof *face
);
4365 face
->charset
= charset
;
4366 face
->registry
= registry
;
4367 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4372 /* Free realized face FACE, including its X resources. FACE may
4376 free_realized_face (f
, face
)
4382 #ifdef HAVE_X_WINDOWS
4387 x_free_gc (f
, face
->gc
);
4391 free_face_colors (f
, face
);
4392 x_destroy_bitmap (f
, face
->stipple
);
4394 #endif /* HAVE_X_WINDOWS */
4401 /* Prepare face FACE for subsequent display on frame F. This
4402 allocated GCs if they haven't been allocated yet or have been freed
4403 by clearing the face cache. */
4406 prepare_face_for_display (f
, face
)
4410 #ifdef HAVE_X_WINDOWS
4411 xassert (FRAME_X_P (f
));
4416 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4418 xgcv
.foreground
= face
->foreground
;
4419 xgcv
.background
= face
->background
;
4420 xgcv
.graphics_exposures
= False
;
4422 /* The font of FACE may be null if we couldn't load it. */
4425 xgcv
.font
= face
->font
->fid
;
4432 xgcv
.fill_style
= FillOpaqueStippled
;
4433 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4434 mask
|= GCFillStyle
| GCStipple
;
4437 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4444 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4445 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4446 ISO8859-1 if the ASCII face suffices. */
4449 face_suitable_for_iso8859_1_p (face
)
4452 int len
= strlen (face
->font_name
);
4453 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4457 /* Value is non-zero if FACE is suitable for displaying characters
4458 of CHARSET. CHARSET < 0 means unibyte text. */
4461 face_suitable_for_charset_p (face
, charset
)
4469 if (EQ (face
->registry
, Vface_default_registry
)
4470 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4473 else if (face
->charset
== charset
)
4475 else if (face
->charset
== CHARSET_ASCII
4476 && charset
== charset_latin_iso8859_1
)
4477 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4478 else if (face
->charset
== charset_latin_iso8859_1
4479 && charset
== CHARSET_ASCII
)
4487 /***********************************************************************
4489 ***********************************************************************/
4491 /* Return a new face cache for frame F. */
4493 static struct face_cache
*
4497 struct face_cache
*c
;
4500 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4501 bzero (c
, sizeof *c
);
4502 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4503 c
->buckets
= (struct face
**) xmalloc (size
);
4504 bzero (c
->buckets
, size
);
4506 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4512 /* Clear out all graphics contexts for all realized faces, except for
4513 the basic faces. This should be done from time to time just to avoid
4514 keeping too many graphics contexts that are no longer needed. */
4518 struct face_cache
*c
;
4520 if (c
&& FRAME_X_P (c
->f
))
4522 #ifdef HAVE_X_WINDOWS
4524 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4526 struct face
*face
= c
->faces_by_id
[i
];
4527 if (face
&& face
->gc
)
4529 x_free_gc (c
->f
, face
->gc
);
4533 #endif /* HAVE_X_WINDOWS */
4538 /* Free all realized faces in face cache C, including basic faces. C
4539 may be null. If faces are freed, make sure the frame's current
4540 matrix is marked invalid, so that a display caused by an expose
4541 event doesn't try to use faces we destroyed. */
4544 free_realized_faces (c
)
4545 struct face_cache
*c
;
4550 struct frame
*f
= c
->f
;
4552 for (i
= 0; i
< c
->used
; ++i
)
4554 free_realized_face (f
, c
->faces_by_id
[i
]);
4555 c
->faces_by_id
[i
] = NULL
;
4559 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4560 bzero (c
->buckets
, size
);
4562 /* Must do a thorough redisplay the next time. Mark current
4563 matrices as invalid because they will reference faces freed
4564 above. This function is also called when a frame is
4565 destroyed. In this case, the root window of F is nil. */
4566 if (WINDOWP (f
->root_window
))
4568 clear_current_matrices (f
);
4569 ++windows_or_buffers_changed
;
4575 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4576 This is done after attributes of a named face have been changed,
4577 because we can't tell which realized faces depend on that face. */
4580 free_all_realized_faces (frame
)
4586 FOR_EACH_FRAME (rest
, frame
)
4587 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4590 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4594 /* Free face cache C and faces in it, including their X resources. */
4598 struct face_cache
*c
;
4602 free_realized_faces (c
);
4604 xfree (c
->faces_by_id
);
4610 /* Cache realized face FACE in face cache C. HASH is the hash value
4611 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4612 collision list of the face hash table of C. This is done because
4613 otherwise lookup_face would find FACE for every charset, even if
4614 faces with the same attributes but for specific charsets exist. */
4617 cache_face (c
, face
, hash
)
4618 struct face_cache
*c
;
4622 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4626 if (face
->fontset
>= 0)
4628 struct face
*last
= c
->buckets
[i
];
4639 c
->buckets
[i
] = face
;
4640 face
->prev
= face
->next
= NULL
;
4646 face
->next
= c
->buckets
[i
];
4648 face
->next
->prev
= face
;
4649 c
->buckets
[i
] = face
;
4652 /* Find a free slot in C->faces_by_id and use the index of the free
4653 slot as FACE->id. */
4654 for (i
= 0; i
< c
->used
; ++i
)
4655 if (c
->faces_by_id
[i
] == NULL
)
4659 /* Maybe enlarge C->faces_by_id. */
4660 if (i
== c
->used
&& c
->used
== c
->size
)
4662 int new_size
= 2 * c
->size
;
4663 int sz
= new_size
* sizeof *c
->faces_by_id
;
4664 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4669 /* Check that FACE got a unique id. */
4674 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4675 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4681 #endif /* GLYPH_DEBUG */
4683 c
->faces_by_id
[i
] = face
;
4689 /* Remove face FACE from cache C. */
4692 uncache_face (c
, face
)
4693 struct face_cache
*c
;
4696 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4699 face
->prev
->next
= face
->next
;
4701 c
->buckets
[i
] = face
->next
;
4704 face
->next
->prev
= face
->prev
;
4706 c
->faces_by_id
[face
->id
] = NULL
;
4707 if (face
->id
== c
->used
)
4712 /* Look up a realized face with face attributes ATTR in the face cache
4713 of frame F. The face will be used to display characters of
4714 CHARSET. CHARSET < 0 means the face will be used to display
4715 unibyte text. The value of face-default-registry is used to choose
4716 a font for the face in that case. Value is the ID of the face
4717 found. If no suitable face is found, realize a new one. */
4720 lookup_face (f
, attr
, charset
)
4725 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4730 xassert (c
!= NULL
);
4731 check_lface_attrs (attr
);
4733 /* Look up ATTR in the face cache. */
4734 hash
= lface_hash (attr
);
4735 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4737 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4738 if (face
->hash
== hash
4739 && (!FRAME_WINDOW_P (f
)
4740 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4741 && lface_equal_p (face
->lface
, attr
))
4744 /* If not found, realize a new face. */
4747 face
= realize_face (c
, attr
, charset
);
4748 cache_face (c
, face
, hash
);
4752 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4754 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4755 #endif /* GLYPH_DEBUG */
4761 /* Return the face id of the realized face for named face SYMBOL on
4762 frame F suitable for displaying characters from CHARSET. CHARSET <
4763 0 means unibyte text. */
4766 lookup_named_face (f
, symbol
, charset
)
4771 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4772 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4773 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4775 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4776 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4777 merge_face_vectors (symbol_attrs
, attrs
);
4778 return lookup_face (f
, attrs
, charset
);
4782 /* Return the ID of the realized ASCII face of Lisp face with ID
4783 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4786 ascii_face_of_lisp_face (f
, lface_id
)
4792 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4794 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4795 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4804 /* Return a face for charset ASCII that is like the face with id
4805 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4806 STEPS < 0 means larger. Value is the id of the face. */
4809 smaller_face (f
, face_id
, steps
)
4813 #ifdef HAVE_X_WINDOWS
4815 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4816 int pt
, last_pt
, last_height
;
4819 struct face
*new_face
;
4821 /* If not called for an X frame, just return the original face. */
4822 if (FRAME_TERMCAP_P (f
))
4825 /* Try in increments of 1/2 pt. */
4826 delta
= steps
< 0 ? 5 : -5;
4827 steps
= abs (steps
);
4829 face
= FACE_FROM_ID (f
, face_id
);
4830 bcopy (face
->lface
, attrs
, sizeof attrs
);
4831 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4832 new_face_id
= face_id
;
4833 last_height
= FONT_HEIGHT (face
->font
);
4837 /* Give up if we cannot find a font within 10pt. */
4838 && abs (last_pt
- pt
) < 100)
4840 /* Look up a face for a slightly smaller/larger font. */
4842 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4843 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4844 new_face
= FACE_FROM_ID (f
, new_face_id
);
4846 /* If height changes, count that as one step. */
4847 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4850 last_height
= FONT_HEIGHT (new_face
->font
);
4857 #else /* not HAVE_X_WINDOWS */
4861 #endif /* not HAVE_X_WINDOWS */
4865 /* Return a face for charset ASCII that is like the face with id
4866 FACE_ID on frame F, but has height HEIGHT. */
4869 face_with_height (f
, face_id
, height
)
4874 #ifdef HAVE_X_WINDOWS
4876 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4878 if (FRAME_TERMCAP_P (f
)
4882 face
= FACE_FROM_ID (f
, face_id
);
4883 bcopy (face
->lface
, attrs
, sizeof attrs
);
4884 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4885 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4886 #endif /* HAVE_X_WINDOWS */
4891 /* Return the face id of the realized face for named face SYMBOL on
4892 frame F suitable for displaying characters from CHARSET (CHARSET <
4893 0 means unibyte text), and use attributes of the face FACE_ID for
4894 attributes that aren't completely specified by SYMBOL. This is
4895 like lookup_named_face, except that the default attributes come
4896 from FACE_ID, not from the default face. FACE_ID is assumed to
4897 be already realized. */
4900 lookup_derived_face (f
, symbol
, charset
, face_id
)
4906 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4907 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4908 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4913 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4914 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4915 merge_face_vectors (symbol_attrs
, attrs
);
4916 return lookup_face (f
, attrs
, charset
);
4921 /***********************************************************************
4923 ***********************************************************************/
4925 DEFUN ("internal-set-font-selection-order",
4926 Finternal_set_font_selection_order
,
4927 Sinternal_set_font_selection_order
, 1, 1, 0,
4928 "Set font selection order for face font selection to ORDER.\n\
4929 ORDER must be a list of length 4 containing the symbols `:width',\n\
4930 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4931 first in ORDER are matched first, e.g. if `:height' appears before\n\
4932 `:weight' in ORDER, font selection first tries to find a font with\n\
4933 a suitable height, and then tries to match the font weight.\n\
4942 CHECK_LIST (order
, 0);
4943 bzero (indices
, sizeof indices
);
4947 CONSP (list
) && i
< DIM (indices
);
4948 list
= XCDR (list
), ++i
)
4950 Lisp_Object attr
= XCAR (list
);
4953 if (EQ (attr
, QCwidth
))
4955 else if (EQ (attr
, QCheight
))
4956 xlfd
= XLFD_POINT_SIZE
;
4957 else if (EQ (attr
, QCweight
))
4959 else if (EQ (attr
, QCslant
))
4964 if (indices
[i
] != 0)
4970 || i
!= DIM (indices
)
4975 signal_error ("Invalid font sort order", order
);
4977 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
4979 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
4980 free_all_realized_faces (Qnil
);
4987 DEFUN ("internal-set-alternative-font-family-alist",
4988 Finternal_set_alternative_font_family_alist
,
4989 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
4990 "Define alternative font families to try in face font selection.\n\
4991 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
4992 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
4993 be found. Value is ALIST.")
4997 CHECK_LIST (alist
, 0);
4998 Vface_alternative_font_family_alist
= alist
;
4999 free_all_realized_faces (Qnil
);
5004 #ifdef HAVE_X_WINDOWS
5006 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5007 Value is nil if not successful. */
5010 deduce_unibyte_registry (f
, font_name
)
5014 struct font_name font
;
5015 Lisp_Object registry
= Qnil
;
5017 font
.name
= STRDUPA (font_name
);
5018 if (split_font_name (f
, &font
, 0))
5022 /* Extract registry and encoding. */
5023 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5024 + strlen (font
.fields
[XLFD_ENCODING
])
5026 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5027 strcat (buffer
, "-");
5028 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5029 registry
= build_string (buffer
);
5036 /* Value is non-zero if FONT is the name of a scalable font. The
5037 X11R6 XLFD spec says that point size, pixel size, and average width
5038 are zero for scalable fonts. Intlfonts contain at least one
5039 scalable font ("*-muleindian-1") for which this isn't true, so we
5040 just test average width. */
5043 font_scalable_p (font
)
5044 struct font_name
*font
;
5046 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5047 return *s
== '0' && *(s
+ 1) == '\0';
5051 /* Value is non-zero if FONT1 is a better match for font attributes
5052 VALUES than FONT2. VALUES is an array of face attribute values in
5053 font sort order. COMPARE_PT_P zero means don't compare point
5057 better_font_p (values
, font1
, font2
, compare_pt_p
)
5059 struct font_name
*font1
, *font2
;
5064 for (i
= 0; i
< 4; ++i
)
5066 int xlfd_idx
= font_sort_order
[i
];
5068 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5070 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5071 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5073 if (delta1
> delta2
)
5075 else if (delta1
< delta2
)
5079 /* The difference may be equal because, e.g., the face
5080 specifies `italic' but we have only `regular' and
5081 `oblique'. Prefer `oblique' in this case. */
5082 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5083 && font1
->numeric
[xlfd_idx
] > values
[i
]
5084 && font2
->numeric
[xlfd_idx
] < values
[i
])
5096 /* Value is non-zero if FONT is an exact match for face attributes in
5097 SPECIFIED. SPECIFIED is an array of face attribute values in font
5101 exact_face_match_p (specified
, font
)
5103 struct font_name
*font
;
5107 for (i
= 0; i
< 4; ++i
)
5108 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5115 /* Value is the name of a scaled font, generated from scalable font
5116 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5117 Value is allocated from heap. */
5120 build_scalable_font_name (f
, font
, specified_pt
)
5122 struct font_name
*font
;
5125 char point_size
[20], pixel_size
[20];
5127 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5130 /* If scalable font is for a specific resolution, compute
5131 the point size we must specify from the resolution of
5132 the display and the specified resolution of the font. */
5133 if (font
->numeric
[XLFD_RESY
] != 0)
5135 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5136 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5141 pixel_value
= resy
/ 720.0 * pt
;
5144 /* Set point size of the font. */
5145 sprintf (point_size
, "%d", (int) pt
);
5146 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5147 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5149 /* Set pixel size. */
5150 sprintf (pixel_size
, "%d", pixel_value
);
5151 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5152 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5154 /* If font doesn't specify its resolution, use the
5155 resolution of the display. */
5156 if (font
->numeric
[XLFD_RESY
] == 0)
5159 sprintf (buffer
, "%d", (int) resy
);
5160 font
->fields
[XLFD_RESY
] = buffer
;
5161 font
->numeric
[XLFD_RESY
] = resy
;
5164 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5167 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5168 sprintf (buffer
, "%d", resx
);
5169 font
->fields
[XLFD_RESX
] = buffer
;
5170 font
->numeric
[XLFD_RESX
] = resx
;
5173 return build_font_name (font
);
5177 /* Value is non-zero if we are allowed to use scalable font FONT. We
5178 can't run a Lisp function here since this function may be called
5179 with input blocked. */
5182 may_use_scalable_font_p (font
, name
)
5183 struct font_name
*font
;
5186 if (EQ (Vscalable_fonts_allowed
, Qt
))
5188 else if (CONSP (Vscalable_fonts_allowed
))
5190 Lisp_Object tail
, regexp
;
5192 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5194 regexp
= XCAR (tail
);
5195 if (STRINGP (regexp
)
5196 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5204 #endif /* SCALABLE_FONTS != 0 */
5207 /* Return the name of the best matching font for face attributes
5208 ATTRS in the array of font_name structures FONTS which contains
5209 NFONTS elements. Value is a font name which is allocated from
5210 the heap. FONTS is freed by this function. */
5213 best_matching_font (f
, attrs
, fonts
, nfonts
)
5216 struct font_name
*fonts
;
5220 struct font_name
*best
;
5228 /* Make specified font attributes available in `specified',
5229 indexed by sort order. */
5230 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5232 int xlfd_idx
= font_sort_order
[i
];
5234 if (xlfd_idx
== XLFD_SWIDTH
)
5235 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5236 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5237 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5238 else if (xlfd_idx
== XLFD_WEIGHT
)
5239 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5240 else if (xlfd_idx
== XLFD_SLANT
)
5241 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5251 /* Start with the first non-scalable font in the list. */
5252 for (i
= 0; i
< nfonts
; ++i
)
5253 if (!font_scalable_p (fonts
+ i
))
5256 /* Find the best match among the non-scalable fonts. */
5261 for (i
= 1; i
< nfonts
; ++i
)
5262 if (!font_scalable_p (fonts
+ i
)
5263 && better_font_p (specified
, fonts
+ i
, best
, 1))
5267 exact_p
= exact_face_match_p (specified
, best
);
5276 /* Unless we found an exact match among non-scalable fonts, see if
5277 we can find a better match among scalable fonts. */
5280 /* A scalable font is better if
5282 1. its weight, slant, swidth attributes are better, or.
5284 2. the best non-scalable font doesn't have the required
5285 point size, and the scalable fonts weight, slant, swidth
5288 int non_scalable_has_exact_height_p
;
5290 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5291 non_scalable_has_exact_height_p
= 1;
5293 non_scalable_has_exact_height_p
= 0;
5295 for (i
= 0; i
< nfonts
; ++i
)
5296 if (font_scalable_p (fonts
+ i
))
5299 || better_font_p (specified
, fonts
+ i
, best
, 0)
5300 || (!non_scalable_has_exact_height_p
5301 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5306 if (font_scalable_p (best
))
5307 font_name
= build_scalable_font_name (f
, best
, pt
);
5309 font_name
= build_font_name (best
);
5311 #else /* !SCALABLE_FONTS */
5313 /* Find the best non-scalable font. */
5316 for (i
= 1; i
< nfonts
; ++i
)
5318 xassert (!font_scalable_p (fonts
+ i
));
5319 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5323 font_name
= build_font_name (best
);
5325 #endif /* !SCALABLE_FONTS */
5327 /* Free font_name structures. */
5328 free_font_names (fonts
, nfonts
);
5334 /* Try to get a list of fonts on frame F with font family FAMILY and
5335 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5336 of font_name structures for the fonts matched. Value is the number
5340 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5343 char *pattern
, *family
, *registry
;
5344 struct font_name
**fonts
;
5349 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5351 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5357 /* Try alternative font families from
5358 Vface_alternative_font_family_alist. */
5359 alter
= Fassoc (build_string (family
),
5360 Vface_alternative_font_family_alist
);
5362 for (alter
= XCDR (alter
);
5363 CONSP (alter
) && nfonts
== 0;
5364 alter
= XCDR (alter
))
5366 if (STRINGP (XCAR (alter
)))
5368 family
= LSTRDUPA (XCAR (alter
));
5369 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5373 /* Try font family of the default face or "fixed". */
5376 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5378 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5381 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5384 /* Try any family with the given registry. */
5386 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5393 /* Return the registry and encoding pattern that fonts for CHARSET
5394 should match. Value is allocated from the heap. */
5397 x_charset_registry (charset
)
5400 Lisp_Object prop
, charset_plist
;
5403 /* Get registry and encoding from the charset's plist. */
5404 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5405 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5409 if (index (XSTRING (prop
)->data
, '-'))
5410 registry
= xstrdup (XSTRING (prop
)->data
);
5413 /* If registry doesn't contain a `-', make it a pattern. */
5414 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5415 strcpy (registry
, XSTRING (prop
)->data
);
5416 strcat (registry
, "*-*");
5419 else if (STRINGP (Vface_default_registry
))
5420 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5422 registry
= xstrdup ("iso8859-1");
5428 /* Return the fontset id of the fontset name or alias name given by
5429 the family attribute of ATTRS on frame F. Value is -1 if the
5430 family attribute of ATTRS doesn't name a fontset. */
5433 face_fontset (f
, attrs
)
5437 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5440 name
= Fquery_fontset (name
, Qnil
);
5444 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5450 /* Get the font to use for the face realizing the fully-specified Lisp
5451 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5452 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5453 in this case. Value is the font name which is allocated from the
5454 heap (which means that it must be freed eventually). */
5457 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5461 Lisp_Object unibyte_registry
;
5463 struct font_name
*fonts
;
5467 /* ATTRS must be fully-specified. */
5468 xassert (lface_fully_specified_p (attrs
));
5470 if (STRINGP (unibyte_registry
))
5471 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5473 registry
= x_charset_registry (charset
);
5475 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5477 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5481 /* Choose a font to use on frame F to display CHARSET using FONTSET
5482 with Lisp face attributes specified by ATTRS. CHARSET may be any
5483 valid charset except CHARSET_COMPOSITION. CHARSET < 0 means
5484 unibyte text. If the fontset doesn't contain a font pattern for
5485 charset, use the pattern for CHARSET_ASCII. Value is the font name
5486 which is allocated from the heap and must be freed by the caller. */
5489 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5492 int fontset
, charset
;
5495 char *font_name
= NULL
;
5496 struct fontset_info
*fontset_info
;
5497 struct font_name
*fonts
;
5500 xassert (charset
!= CHARSET_COMPOSITION
);
5501 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5503 /* For unibyte text, use the ASCII font of the fontset. Using the
5504 ASCII font seems to be the most reasonable thing we can do in
5507 charset
= CHARSET_ASCII
;
5509 /* Get the font name pattern to use for CHARSET from the fontset. */
5510 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5511 pattern
= fontset_info
->fontname
[charset
];
5513 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5516 /* Get a list of fonts matching that pattern and choose the
5517 best match for the specified face attributes from it. */
5518 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5519 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5523 #endif /* HAVE_X_WINDOWS */
5527 /***********************************************************************
5529 ***********************************************************************/
5531 /* Realize basic faces on frame F. Value is zero if frame parameters
5532 of F don't contain enough information needed to realize the default
5536 realize_basic_faces (f
)
5541 if (realize_default_face (f
))
5543 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5544 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5545 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5546 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5547 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5548 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5549 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5550 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5551 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5559 /* Realize the default face on frame F. If the face is not fully
5560 specified, make it fully-specified. Attributes of the default face
5561 that are not explicitly specified are taken from frame parameters. */
5564 realize_default_face (f
)
5567 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5569 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5570 Lisp_Object unibyte_registry
;
5571 Lisp_Object frame_font
;
5575 /* If the `default' face is not yet known, create it. */
5576 lface
= lface_from_face_name (f
, Qdefault
, 0);
5580 XSETFRAME (frame
, f
);
5581 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5584 #ifdef HAVE_X_WINDOWS
5587 /* Set frame_font to the value of the `font' frame parameter. */
5588 frame_font
= Fassq (Qfont
, f
->param_alist
);
5589 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5590 frame_font
= XCDR (frame_font
);
5592 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5595 /* If frame_font is a fontset name, don't use that for
5596 determining font-related attributes of the default face
5597 because it is just an artificial name. Use the ASCII font of
5598 the fontset, instead. */
5599 struct font_info
*font_info
;
5600 struct font_name font
;
5603 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5607 /* Set weight etc. from the ASCII font. */
5608 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5611 /* Remember registry and encoding of the frame font. */
5612 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5613 if (STRINGP (unibyte_registry
))
5614 Vface_default_registry
= unibyte_registry
;
5616 Vface_default_registry
= build_string ("iso8859-1");
5618 /* But set the family to the fontset alias name. Implementation
5619 note: When a font is passed to Emacs via `-fn FONT', a
5620 fontset is created in `x-win.el' whose name ends in
5621 `fontset-startup'. This fontset has an alias name that is
5622 equal to frame_font. */
5623 xassert (STRINGP (frame_font
));
5624 font
.name
= LSTRDUPA (frame_font
);
5626 if (!split_font_name (f
, &font
, 1)
5627 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5628 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5629 LFACE_FAMILY (lface
) = frame_font
;
5633 /* Frame parameters contain a real font. Fill default face
5634 attributes from that font. */
5635 if (!set_lface_from_font_name (f
, lface
,
5636 XSTRING (frame_font
)->data
, 0, 0))
5639 /* Remember registry and encoding of the frame font. */
5641 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5642 if (STRINGP (unibyte_registry
))
5643 Vface_default_registry
= unibyte_registry
;
5645 Vface_default_registry
= build_string ("iso8859-1");
5648 #endif /* HAVE_X_WINDOWS */
5650 if (!FRAME_WINDOW_P (f
))
5652 LFACE_FAMILY (lface
) = build_string ("default");
5653 LFACE_SWIDTH (lface
) = Qnormal
;
5654 LFACE_HEIGHT (lface
) = make_number (1);
5655 LFACE_WEIGHT (lface
) = Qnormal
;
5656 LFACE_SLANT (lface
) = Qnormal
;
5659 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5660 LFACE_UNDERLINE (lface
) = Qnil
;
5662 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5663 LFACE_OVERLINE (lface
) = Qnil
;
5665 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5666 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5668 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5669 LFACE_BOX (lface
) = Qnil
;
5671 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5672 LFACE_INVERSE (lface
) = Qnil
;
5674 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5676 /* This function is called so early that colors are not yet
5677 set in the frame parameter list. */
5678 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5680 if (CONSP (color
) && STRINGP (XCDR (color
)))
5681 LFACE_FOREGROUND (lface
) = XCDR (color
);
5682 else if (FRAME_X_P (f
))
5684 else if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5688 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5690 /* This function is called so early that colors are not yet
5691 set in the frame parameter list. */
5692 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5693 if (CONSP (color
) && STRINGP (XCDR (color
)))
5694 LFACE_BACKGROUND (lface
) = XCDR (color
);
5695 else if (FRAME_X_P (f
))
5697 else if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5701 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5702 LFACE_STIPPLE (lface
) = Qnil
;
5704 /* Realize the face; it must be fully-specified now. */
5705 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5706 check_lface (lface
);
5707 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5708 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5710 /* Remove the former default face. */
5711 if (c
->used
> DEFAULT_FACE_ID
)
5713 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5714 uncache_face (c
, default_face
);
5715 free_realized_face (f
, default_face
);
5718 /* Insert the new default face. */
5719 cache_face (c
, face
, lface_hash (attrs
));
5720 xassert (face
->id
== DEFAULT_FACE_ID
);
5725 /* Realize basic faces other than the default face in face cache C.
5726 SYMBOL is the face name, ID is the face id the realized face must
5727 have. The default face must have been realized already. */
5730 realize_named_face (f
, symbol
, id
)
5735 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5736 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5737 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5738 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5739 struct face
*new_face
;
5741 /* The default face must exist and be fully specified. */
5742 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5743 check_lface_attrs (attrs
);
5744 xassert (lface_fully_specified_p (attrs
));
5746 /* If SYMBOL isn't know as a face, create it. */
5750 XSETFRAME (frame
, f
);
5751 lface
= Finternal_make_lisp_face (symbol
, frame
);
5754 /* Merge SYMBOL's face with the default face. */
5755 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5756 merge_face_vectors (symbol_attrs
, attrs
);
5758 /* Realize the face. */
5759 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5761 /* Remove the former face. */
5764 struct face
*old_face
= c
->faces_by_id
[id
];
5765 uncache_face (c
, old_face
);
5766 free_realized_face (f
, old_face
);
5769 /* Insert the new face. */
5770 cache_face (c
, new_face
, lface_hash (attrs
));
5771 xassert (new_face
->id
== id
);
5775 /* Realize the fully-specified face with attributes ATTRS in face
5776 cache C for character set CHARSET or for unibyte text if CHARSET <
5777 0. Value is a pointer to the newly created realized face. */
5779 static struct face
*
5780 realize_face (c
, attrs
, charset
)
5781 struct face_cache
*c
;
5787 /* LFACE must be fully specified. */
5788 xassert (c
!= NULL
);
5789 check_lface_attrs (attrs
);
5791 if (FRAME_X_P (c
->f
))
5792 face
= realize_x_face (c
, attrs
, charset
);
5793 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5794 face
= realize_tty_face (c
, attrs
, charset
);
5802 /* Realize the fully-specified face with attributes ATTRS in face
5803 cache C for character set CHARSET or for unibyte text if CHARSET <
5804 0. Do it for X frame C->f. Value is a pointer to the newly
5805 created realized face. */
5807 static struct face
*
5808 realize_x_face (c
, attrs
, charset
)
5809 struct face_cache
*c
;
5813 #ifdef HAVE_X_WINDOWS
5814 struct face
*face
, *default_face
;
5815 struct frame
*f
= c
->f
;
5816 Lisp_Object stipple
, overline
, strike_through
, box
;
5817 Lisp_Object unibyte_registry
;
5818 struct gcpro gcpro1
;
5820 xassert (FRAME_X_P (f
));
5822 /* If realizing a face for use in unibyte text, get the X registry
5823 and encoding to use from Vface_default_registry. */
5825 unibyte_registry
= (STRINGP (Vface_default_registry
)
5826 ? Vface_default_registry
5827 : build_string ("iso8859-1"));
5829 unibyte_registry
= Qnil
;
5830 GCPRO1 (unibyte_registry
);
5832 /* Allocate a new realized face. */
5833 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5835 /* Determine the font to use. Most of the time, the font will be
5836 the same as the font of the default face, so try that first. */
5837 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5839 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5840 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5842 face
->font
= default_face
->font
;
5843 face
->fontset
= default_face
->fontset
;
5844 face
->font_info_id
= default_face
->font_info_id
;
5845 face
->font_name
= default_face
->font_name
;
5846 face
->registry
= default_face
->registry
;
5848 else if (charset
>= 0)
5850 /* For all charsets except CHARSET_COMPOSITION, we use our own
5851 font selection functions to choose a best matching font for
5852 the specified face attributes. If the face specifies a
5853 fontset alias name, the fontset determines the font name
5854 pattern, otherwise we construct a font pattern from face
5855 attributes and charset.
5857 If charset is CHARSET_COMPOSITION, we always construct a face
5858 with a fontset, even if the face doesn't specify a fontset alias
5859 (we use fontset-standard in that case). When the composite
5860 character is displayed in xterm.c, a suitable concrete font is
5861 loaded in x_get_char_font_and_encoding. */
5863 char *font_name
= NULL
;
5864 int fontset
= face_fontset (f
, attrs
);
5866 if (charset
== CHARSET_COMPOSITION
)
5867 fontset
= max (0, fontset
);
5868 else if (fontset
< 0)
5869 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5872 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5876 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5881 /* Unibyte case, and font is not equal to that of the default
5882 face. UNIBYTE_REGISTRY is the X registry and encoding the
5883 font should have. What is a reasonable thing to do if the
5884 user specified a fontset alias name for the face in this
5885 case? We choose a font by taking the ASCII font of the
5886 fontset, but using UNIBYTE_REGISTRY for its registry and
5889 char *font_name
= NULL
;
5890 int fontset
= face_fontset (f
, attrs
);
5893 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5895 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5897 load_face_font_or_fontset (f
, face
, font_name
, -1);
5901 /* Load colors, and set remaining attributes. */
5903 load_face_colors (f
, face
, attrs
);
5906 box
= attrs
[LFACE_BOX_INDEX
];
5909 /* A simple box of line width 1 drawn in color given by
5911 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5913 face
->box
= FACE_SIMPLE_BOX
;
5914 face
->box_line_width
= 1;
5916 else if (INTEGERP (box
))
5918 /* Simple box of specified line width in foreground color of the
5920 xassert (XINT (box
) > 0);
5921 face
->box
= FACE_SIMPLE_BOX
;
5922 face
->box_line_width
= XFASTINT (box
);
5923 face
->box_color
= face
->foreground
;
5924 face
->box_color_defaulted_p
= 1;
5926 else if (CONSP (box
))
5928 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5929 being one of `raised' or `sunken'. */
5930 face
->box
= FACE_SIMPLE_BOX
;
5931 face
->box_color
= face
->foreground
;
5932 face
->box_color_defaulted_p
= 1;
5933 face
->box_line_width
= 1;
5937 Lisp_Object keyword
, value
;
5939 keyword
= XCAR (box
);
5947 if (EQ (keyword
, QCline_width
))
5949 if (INTEGERP (value
) && XINT (value
) > 0)
5950 face
->box_line_width
= XFASTINT (value
);
5952 else if (EQ (keyword
, QCcolor
))
5954 if (STRINGP (value
))
5956 face
->box_color
= load_color (f
, face
, value
,
5958 face
->use_box_color_for_shadows_p
= 1;
5961 else if (EQ (keyword
, QCstyle
))
5963 if (EQ (value
, Qreleased_button
))
5964 face
->box
= FACE_RAISED_BOX
;
5965 else if (EQ (value
, Qpressed_button
))
5966 face
->box
= FACE_SUNKEN_BOX
;
5971 /* Text underline, overline, strike-through. */
5973 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5975 /* Use default color (same as foreground color). */
5976 face
->underline_p
= 1;
5977 face
->underline_defaulted_p
= 1;
5978 face
->underline_color
= 0;
5980 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5982 /* Use specified color. */
5983 face
->underline_p
= 1;
5984 face
->underline_defaulted_p
= 0;
5985 face
->underline_color
5986 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5987 LFACE_UNDERLINE_INDEX
);
5989 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5991 face
->underline_p
= 0;
5992 face
->underline_defaulted_p
= 0;
5993 face
->underline_color
= 0;
5996 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5997 if (STRINGP (overline
))
5999 face
->overline_color
6000 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6001 LFACE_OVERLINE_INDEX
);
6002 face
->overline_p
= 1;
6004 else if (EQ (overline
, Qt
))
6006 face
->overline_color
= face
->foreground
;
6007 face
->overline_color_defaulted_p
= 1;
6008 face
->overline_p
= 1;
6011 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6012 if (STRINGP (strike_through
))
6014 face
->strike_through_color
6015 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6016 LFACE_STRIKE_THROUGH_INDEX
);
6017 face
->strike_through_p
= 1;
6019 else if (EQ (strike_through
, Qt
))
6021 face
->strike_through_color
= face
->foreground
;
6022 face
->strike_through_color_defaulted_p
= 1;
6023 face
->strike_through_p
= 1;
6026 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6027 if (!NILP (stipple
))
6028 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6031 xassert (face
->fontset
< 0 || face
->charset
== CHARSET_COMPOSITION
);
6032 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6034 #endif /* HAVE_X_WINDOWS */
6038 /* Realize the fully-specified face with attributes ATTRS in face
6039 cache C for character set CHARSET or for unibyte text if CHARSET <
6040 0. Do it for TTY frame C->f. Value is a pointer to the newly
6041 created realized face. */
6043 static struct face
*
6044 realize_tty_face (c
, attrs
, charset
)
6045 struct face_cache
*c
;
6052 Lisp_Object tty_color_alist
= Fsymbol_value (intern ("tty-color-alist"));
6053 int face_colors_defaulted
= 0;
6055 /* Frame must be a termcap frame. */
6056 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6058 /* Allocate a new realized face. */
6059 face
= make_realized_face (attrs
, charset
, Qnil
);
6060 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6062 /* Map face attributes to TTY appearances. We map slant to
6063 dimmed text because we want italic text to appear differently
6064 and because dimmed text is probably used infrequently. */
6065 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6066 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6068 if (weight
> XLFD_WEIGHT_MEDIUM
)
6069 face
->tty_bold_p
= 1;
6070 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6071 face
->tty_dim_p
= 1;
6072 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6073 face
->tty_underline_p
= 1;
6074 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6075 face
->tty_reverse_p
= 1;
6077 /* Map color names to color indices. */
6078 face
->foreground
= face
->background
= FACE_TTY_DEFAULT_COLOR
;
6080 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6082 && XSTRING (color
)->size
6083 && !NILP (tty_color_alist
)
6084 && (color
= Fassoc (color
, tty_color_alist
),
6086 /* Associations in tty-color-alist are of the form
6087 (NAME INDEX R G B). We need the INDEX part. */
6088 face
->foreground
= XINT (XCAR (XCDR (color
)));
6090 if (face
->foreground
== FACE_TTY_DEFAULT_COLOR
6091 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6093 face
->foreground
= load_color (c
->f
, face
,
6094 attrs
[LFACE_FOREGROUND_INDEX
],
6095 LFACE_FOREGROUND_INDEX
);
6097 /* If the foreground of the default face is the default color,
6098 use the foreground color defined by the frame. */
6099 if (FRAME_MSDOS_P (c
->f
) && face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6101 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6102 attrs
[LFACE_FOREGROUND_INDEX
] =
6103 msdos_stdcolor_name (face
->foreground
);
6104 face_colors_defaulted
= 1;
6109 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6111 && XSTRING (color
)->size
6112 && !NILP (tty_color_alist
)
6113 && (color
= Fassoc (color
, tty_color_alist
),
6115 /* Associations in tty-color-alist are of the form
6116 (NAME INDEX R G B). We need the INDEX part. */
6117 face
->background
= XINT (XCAR (XCDR (color
)));
6119 if (face
->background
== FACE_TTY_DEFAULT_COLOR
6120 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6122 face
->background
= load_color (c
->f
, face
,
6123 attrs
[LFACE_BACKGROUND_INDEX
],
6124 LFACE_BACKGROUND_INDEX
);
6126 /* If the background of the default face is the default color,
6127 use the background color defined by the frame. */
6128 if (FRAME_MSDOS_P (c
->f
) && face
->background
== FACE_TTY_DEFAULT_COLOR
)
6130 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6131 attrs
[LFACE_BACKGROUND_INDEX
] =
6132 msdos_stdcolor_name (face
->background
);
6133 face_colors_defaulted
= 1;
6138 /* Swap colors if face is inverse-video. If the colors are taken
6139 from the frame colors, they are already inverted, since the
6140 frame-creation function calls x-handle-reverse-video. */
6141 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6143 unsigned long tem
= face
->foreground
;
6145 face
->foreground
= face
->background
;
6146 face
->background
= tem
;
6154 /***********************************************************************
6156 ***********************************************************************/
6158 /* Return the ID of the face to use to display character CH with face
6159 property PROP on frame F in current_buffer. */
6162 compute_char_face (f
, ch
, prop
)
6168 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6170 : CHAR_CHARSET (ch
));
6173 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6176 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6177 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6178 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6179 merge_face_vector_with_property (f
, attrs
, prop
);
6180 face_id
= lookup_face (f
, attrs
, charset
);
6187 /* Return the face ID associated with buffer position POS for
6188 displaying ASCII characters. Return in *ENDPTR the position at
6189 which a different face is needed, as far as text properties and
6190 overlays are concerned. W is a window displaying current_buffer.
6192 REGION_BEG, REGION_END delimit the region, so it can be
6195 LIMIT is a position not to scan beyond. That is to limit the time
6196 this function can take.
6198 If MOUSE is non-zero, use the character's mouse-face, not its face.
6200 The face returned is suitable for displaying CHARSET_ASCII if
6201 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6202 the face is suitable for displaying unibyte text. */
6205 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6206 endptr
, limit
, mouse
)
6209 int region_beg
, region_end
;
6214 struct frame
*f
= XFRAME (w
->frame
);
6215 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6216 Lisp_Object prop
, position
;
6218 Lisp_Object
*overlay_vec
;
6221 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6222 Lisp_Object limit1
, end
;
6223 struct face
*default_face
;
6224 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6226 /* W must display the current buffer. We could write this function
6227 to use the frame and buffer of W, but right now it doesn't. */
6228 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6230 XSETFRAME (frame
, f
);
6231 XSETFASTINT (position
, pos
);
6234 if (pos
< region_beg
&& region_beg
< endpos
)
6235 endpos
= region_beg
;
6237 /* Get the `face' or `mouse_face' text property at POS, and
6238 determine the next position at which the property changes. */
6239 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6240 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6241 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6243 endpos
= XINT (end
);
6245 /* Look at properties from overlays. */
6250 /* First try with room for 40 overlays. */
6252 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6253 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6254 &next_overlay
, NULL
);
6256 /* If there are more than 40, make enough space for all, and try
6258 if (noverlays
> len
)
6261 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6262 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6263 &next_overlay
, NULL
);
6266 if (next_overlay
< endpos
)
6267 endpos
= next_overlay
;
6272 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6274 /* Optimize common cases where we can use the default face. */
6277 && !(pos
>= region_beg
&& pos
< region_end
)
6279 || !FRAME_WINDOW_P (f
)
6280 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6281 return DEFAULT_FACE_ID
;
6283 /* Begin with attributes from the default face. */
6284 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6286 /* Merge in attributes specified via text properties. */
6288 merge_face_vector_with_property (f
, attrs
, prop
);
6290 /* Now merge the overlay data. */
6291 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6292 for (i
= 0; i
< noverlays
; i
++)
6297 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6299 merge_face_vector_with_property (f
, attrs
, prop
);
6301 oend
= OVERLAY_END (overlay_vec
[i
]);
6302 oendpos
= OVERLAY_POSITION (oend
);
6303 if (oendpos
< endpos
)
6307 /* If in the region, merge in the region face. */
6308 if (pos
>= region_beg
&& pos
< region_end
)
6310 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6311 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6313 if (region_end
< endpos
)
6314 endpos
= region_end
;
6319 /* Look up a realized face with the given face attributes,
6320 or realize a new one. Charset is ignored for tty frames. */
6321 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6325 /* Compute the face at character position POS in Lisp string STRING on
6326 window W, for charset CHARSET_ASCII.
6328 If STRING is an overlay string, it comes from position BUFPOS in
6329 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6330 not an overlay string. W must display the current buffer.
6331 REGION_BEG and REGION_END give the start and end positions of the
6332 region; both are -1 if no region is visible. BASE_FACE_ID is the
6333 id of the basic face to merge with. It is usually equal to
6334 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6335 for strings displayed in the mode or top line.
6337 Set *ENDPTR to the next position where to check for faces in
6338 STRING; -1 if the face is constant from POS to the end of the
6341 Value is the id of the face to use. The face returned is suitable
6342 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6343 the face is suitable for displaying unibyte text. */
6346 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6347 region_end
, endptr
, base_face_id
)
6351 int region_beg
, region_end
;
6353 enum face_id base_face_id
;
6355 Lisp_Object prop
, position
, end
, limit
;
6356 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6357 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6358 struct face
*base_face
;
6359 int multibyte_p
= STRING_MULTIBYTE (string
);
6361 /* Get the value of the face property at the current position within
6362 STRING. Value is nil if there is no face property. */
6363 XSETFASTINT (position
, pos
);
6364 prop
= Fget_text_property (position
, Qface
, string
);
6366 /* Get the next position at which to check for faces. Value of end
6367 is nil if face is constant all the way to the end of the string.
6368 Otherwise it is a string position where to check faces next.
6369 Limit is the maximum position up to which to check for property
6370 changes in Fnext_single_property_change. Strings are usually
6371 short, so set the limit to the end of the string. */
6372 XSETFASTINT (limit
, XSTRING (string
)->size
);
6373 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6375 *endptr
= XFASTINT (end
);
6379 base_face
= FACE_FROM_ID (f
, base_face_id
);
6380 xassert (base_face
);
6382 /* Optimize the default case that there is no face property and we
6383 are not in the region. */
6385 && (base_face_id
!= DEFAULT_FACE_ID
6386 /* BUFPOS <= 0 means STRING is not an overlay string, so
6387 that the region doesn't have to be taken into account. */
6389 || bufpos
< region_beg
6390 || bufpos
>= region_end
)
6392 /* We can't realize faces for different charsets differently
6393 if we don't have fonts, so we can stop here if not working
6394 on a window-system frame. */
6395 || !FRAME_WINDOW_P (f
)
6396 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6397 return base_face
->id
;
6399 /* Begin with attributes from the base face. */
6400 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6402 /* Merge in attributes specified via text properties. */
6404 merge_face_vector_with_property (f
, attrs
, prop
);
6406 /* If in the region, merge in the region face. */
6408 && bufpos
>= region_beg
6409 && bufpos
< region_end
)
6411 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6412 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6415 /* Look up a realized face with the given face attributes,
6416 or realize a new one. */
6417 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6422 /***********************************************************************
6424 ***********************************************************************/
6428 /* Print the contents of the realized face FACE to stderr. */
6431 dump_realized_face (face
)
6434 fprintf (stderr
, "ID: %d\n", face
->id
);
6435 #ifdef HAVE_X_WINDOWS
6436 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6438 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6440 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6441 fprintf (stderr
, "background: 0x%lx (%s)\n",
6443 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6444 fprintf (stderr
, "font_name: %s (%s)\n",
6446 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6447 #ifdef HAVE_X_WINDOWS
6448 fprintf (stderr
, "font = %p\n", face
->font
);
6450 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6451 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6452 fprintf (stderr
, "underline: %d (%s)\n",
6454 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6455 fprintf (stderr
, "hash: %d\n", face
->hash
);
6456 fprintf (stderr
, "charset: %d\n", face
->charset
);
6460 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6468 fprintf (stderr
, "font selection order: ");
6469 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6470 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6471 fprintf (stderr
, "\n");
6473 fprintf (stderr
, "alternative fonts: ");
6474 debug_print (Vface_alternative_font_family_alist
);
6475 fprintf (stderr
, "\n");
6477 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6478 Fdump_face (make_number (i
));
6483 CHECK_NUMBER (n
, 0);
6484 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6486 error ("Not a valid face");
6487 dump_realized_face (face
);
6494 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6498 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6499 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6500 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6504 #endif /* GLYPH_DEBUG != 0 */
6508 /***********************************************************************
6510 ***********************************************************************/
6515 Qface
= intern ("face");
6517 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6518 staticpro (&Qbitmap_spec_p
);
6519 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6520 staticpro (&Qframe_update_face_colors
);
6522 /* Lisp face attribute keywords. */
6523 QCfamily
= intern (":family");
6524 staticpro (&QCfamily
);
6525 QCheight
= intern (":height");
6526 staticpro (&QCheight
);
6527 QCweight
= intern (":weight");
6528 staticpro (&QCweight
);
6529 QCslant
= intern (":slant");
6530 staticpro (&QCslant
);
6531 QCunderline
= intern (":underline");
6532 staticpro (&QCunderline
);
6533 QCinverse_video
= intern (":inverse-video");
6534 staticpro (&QCinverse_video
);
6535 QCreverse_video
= intern (":reverse-video");
6536 staticpro (&QCreverse_video
);
6537 QCforeground
= intern (":foreground");
6538 staticpro (&QCforeground
);
6539 QCbackground
= intern (":background");
6540 staticpro (&QCbackground
);
6541 QCstipple
= intern (":stipple");;
6542 staticpro (&QCstipple
);
6543 QCwidth
= intern (":width");
6544 staticpro (&QCwidth
);
6545 QCfont
= intern (":font");
6546 staticpro (&QCfont
);
6547 QCbold
= intern (":bold");
6548 staticpro (&QCbold
);
6549 QCitalic
= intern (":italic");
6550 staticpro (&QCitalic
);
6551 QCoverline
= intern (":overline");
6552 staticpro (&QCoverline
);
6553 QCstrike_through
= intern (":strike-through");
6554 staticpro (&QCstrike_through
);
6555 QCbox
= intern (":box");
6558 /* Symbols used for Lisp face attribute values. */
6559 QCcolor
= intern (":color");
6560 staticpro (&QCcolor
);
6561 QCline_width
= intern (":line-width");
6562 staticpro (&QCline_width
);
6563 QCstyle
= intern (":style");
6564 staticpro (&QCstyle
);
6565 Qreleased_button
= intern ("released-button");
6566 staticpro (&Qreleased_button
);
6567 Qpressed_button
= intern ("pressed-button");
6568 staticpro (&Qpressed_button
);
6569 Qnormal
= intern ("normal");
6570 staticpro (&Qnormal
);
6571 Qultra_light
= intern ("ultra-light");
6572 staticpro (&Qultra_light
);
6573 Qextra_light
= intern ("extra-light");
6574 staticpro (&Qextra_light
);
6575 Qlight
= intern ("light");
6576 staticpro (&Qlight
);
6577 Qsemi_light
= intern ("semi-light");
6578 staticpro (&Qsemi_light
);
6579 Qsemi_bold
= intern ("semi-bold");
6580 staticpro (&Qsemi_bold
);
6581 Qbold
= intern ("bold");
6583 Qextra_bold
= intern ("extra-bold");
6584 staticpro (&Qextra_bold
);
6585 Qultra_bold
= intern ("ultra-bold");
6586 staticpro (&Qultra_bold
);
6587 Qoblique
= intern ("oblique");
6588 staticpro (&Qoblique
);
6589 Qitalic
= intern ("italic");
6590 staticpro (&Qitalic
);
6591 Qreverse_oblique
= intern ("reverse-oblique");
6592 staticpro (&Qreverse_oblique
);
6593 Qreverse_italic
= intern ("reverse-italic");
6594 staticpro (&Qreverse_italic
);
6595 Qultra_condensed
= intern ("ultra-condensed");
6596 staticpro (&Qultra_condensed
);
6597 Qextra_condensed
= intern ("extra-condensed");
6598 staticpro (&Qextra_condensed
);
6599 Qcondensed
= intern ("condensed");
6600 staticpro (&Qcondensed
);
6601 Qsemi_condensed
= intern ("semi-condensed");
6602 staticpro (&Qsemi_condensed
);
6603 Qsemi_expanded
= intern ("semi-expanded");
6604 staticpro (&Qsemi_expanded
);
6605 Qexpanded
= intern ("expanded");
6606 staticpro (&Qexpanded
);
6607 Qextra_expanded
= intern ("extra-expanded");
6608 staticpro (&Qextra_expanded
);
6609 Qultra_expanded
= intern ("ultra-expanded");
6610 staticpro (&Qultra_expanded
);
6611 Qbackground_color
= intern ("background-color");
6612 staticpro (&Qbackground_color
);
6613 Qforeground_color
= intern ("foreground-color");
6614 staticpro (&Qforeground_color
);
6615 Qunspecified
= intern ("unspecified");
6616 staticpro (&Qunspecified
);
6618 Qx_charset_registry
= intern ("x-charset-registry");
6619 staticpro (&Qx_charset_registry
);
6620 Qface_alias
= intern ("face-alias");
6621 staticpro (&Qface_alias
);
6622 Qdefault
= intern ("default");
6623 staticpro (&Qdefault
);
6624 Qtool_bar
= intern ("tool-bar");
6625 staticpro (&Qtool_bar
);
6626 Qregion
= intern ("region");
6627 staticpro (&Qregion
);
6628 Qfringe
= intern ("fringe");
6629 staticpro (&Qfringe
);
6630 Qheader_line
= intern ("header-line");
6631 staticpro (&Qheader_line
);
6632 Qscroll_bar
= intern ("scroll-bar");
6633 staticpro (&Qscroll_bar
);
6634 Qmenu
= intern ("menu");
6636 Qcursor
= intern ("cursor");
6637 staticpro (&Qcursor
);
6638 Qborder
= intern ("border");
6639 staticpro (&Qborder
);
6640 Qmouse
= intern ("mouse");
6641 staticpro (&Qmouse
);
6642 Qtty_color_desc
= intern ("tty-color-desc");
6643 staticpro (&Qtty_color_desc
);
6644 Qtty_color_by_index
= intern ("tty-color-by-index");
6645 staticpro (&Qtty_color_by_index
);
6647 defsubr (&Sinternal_make_lisp_face
);
6648 defsubr (&Sinternal_lisp_face_p
);
6649 defsubr (&Sinternal_set_lisp_face_attribute
);
6650 #ifdef HAVE_X_WINDOWS
6651 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6652 defsubr (&Sface_color_gray_p
);
6653 defsubr (&Sface_color_supported_p
);
6655 defsubr (&Sinternal_get_lisp_face_attribute
);
6656 defsubr (&Sinternal_lisp_face_attribute_values
);
6657 defsubr (&Sinternal_lisp_face_equal_p
);
6658 defsubr (&Sinternal_lisp_face_empty_p
);
6659 defsubr (&Sinternal_copy_lisp_face
);
6660 defsubr (&Sinternal_merge_in_global_face
);
6661 defsubr (&Sface_font
);
6662 defsubr (&Sframe_face_alist
);
6663 defsubr (&Sinternal_set_font_selection_order
);
6664 defsubr (&Sinternal_set_alternative_font_family_alist
);
6666 defsubr (&Sdump_face
);
6667 defsubr (&Sshow_face_resources
);
6668 #endif /* GLYPH_DEBUG */
6669 defsubr (&Sclear_face_cache
);
6671 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6672 "*Limit for font matching.\n\
6673 If an integer > 0, font matching functions won't load more than\n\
6674 that number of fonts when searching for a matching font.");
6675 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6677 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6678 "List of global face definitions (for internal use only.)");
6679 Vface_new_frame_defaults
= Qnil
;
6681 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6682 "*Default stipple pattern used on monochrome displays.\n\
6683 This stipple pattern is used on monochrome displays\n\
6684 instead of shades of gray for a face background color.\n\
6685 See `set-face-stipple' for possible values for this variable.");
6686 Vface_default_stipple
= build_string ("gray3");
6688 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6689 "Default registry and encoding to use.\n\
6690 This registry and encoding is used for unibyte text. It is set up\n\
6691 from the specified frame font when Emacs starts. (For internal use only.)");
6692 Vface_default_registry
= Qnil
;
6694 DEFVAR_LISP ("face-alternative-font-family-alist",
6695 &Vface_alternative_font_family_alist
, "");
6696 Vface_alternative_font_family_alist
= Qnil
;
6700 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6701 "Allowed scalable fonts.\n\
6702 A value of nil means don't allow any scalable fonts.\n\
6703 A value of t means allow any scalable font.\n\
6704 Otherwise, value must be a list of regular expressions. A font may be\n\
6705 scaled if its name matches a regular expression in the list.");
6706 Vscalable_fonts_allowed
= Qnil
;
6708 #endif /* SCALABLE_FONTS */
6710 #ifdef HAVE_X_WINDOWS
6711 defsubr (&Sbitmap_spec_p
);
6712 defsubr (&Sx_list_fonts
);
6713 defsubr (&Sinternal_face_x_get_resource
);
6714 defsubr (&Sx_family_fonts
);
6715 defsubr (&Sx_font_family_list
);
6716 #endif /* HAVE_X_WINDOWS */