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 Faces are always realized for a specific character set and contain
100 a specific font, even if the face being realized specifies a
101 fontset (see `font selection' below). The reason is that the
102 result of the new font selection stage is better than what can be
103 done with statically defined font name patterns in fontsets.
108 In unibyte text, Emacs' charsets aren't applicable; function
109 `char-charset' reports CHARSET_ASCII for all characters, including
110 those > 0x7f. The X registry and encoding of fonts to use is
111 determined from the variable `x-unibyte-registry-and-encoding' in
112 this case. The variable is initialized at Emacs startup time from
113 the font the user specified for Emacs.
115 Currently all unibyte text, i.e. all buffers with
116 enable_multibyte_characters nil are displayed with fonts of the
117 same registry and encoding `x-unibyte-registry-and-encoding'. This
118 is consistent with the fact that languages can also be set
124 Font selection tries to find the best available matching font for a
125 given (charset, face) combination. This is done slightly
126 differently for faces specifying a fontset, or a font family name.
128 If the face specifies a fontset alias name, that fontset determines
129 a pattern for fonts of the given charset. If the face specifies a
130 font family, a font pattern is constructed. Charset symbols have a
131 property `x-charset-registry' for that purpose that maps a charset
132 to an XLFD registry and encoding in the font pattern constructed.
134 Available fonts on the system on which Emacs runs are then matched
135 against the font pattern. The result of font selection is the best
136 match for the given face attributes in this font list.
138 Font selection can be influenced by the user.
140 1. The user can specify the relative importance he gives the face
141 attributes width, height, weight, and slant by setting
142 face-font-selection-order (faces.el) to a list of face attribute
143 names. The default is '(:width :height :weight :slant), and means
144 that font selection first tries to find a good match for the font
145 width specified by a face, then---within fonts with that
146 width---tries to find a best match for the specified font height,
149 2. Setting face-alternative-font-family-alist allows the user to
150 specify alternative font families to try if a family specified by a
154 Composite characters.
156 Realized faces for composite characters are the only ones having a
157 fontset id >= 0. When a composite character is encoded into a
158 sequence of non-composite characters (in xterm.c), a suitable font
159 for the non-composite characters is then selected and realized,
160 i.e. the realization process is delayed but in principle the same.
163 Initialization of basic faces.
165 The faces `default', `modeline' are considered `basic faces'.
166 When redisplay happens the first time for a newly created frame,
167 basic faces are realized for CHARSET_ASCII. Frame parameters are
168 used to fill in unspecified attributes of the default face. */
170 /* Define SCALABLE_FONTS to a non-zero value to enable scalable
171 font use. Define it to zero to disable scalable font use.
173 Use of too many or too large scalable fonts can crash XFree86
174 servers. That's why I've put the code dealing with scalable fonts
177 #define SCALABLE_FONTS 1
180 #include <sys/types.h>
181 #include <sys/stat.h>
186 #ifdef HAVE_X_WINDOWS
191 #include <Xm/XmStrDefs.h>
192 #endif /* USE_MOTIF */
200 #include "dispextern.h"
201 #include "blockinput.h"
203 #include "intervals.h"
205 #ifdef HAVE_X_WINDOWS
207 /* Compensate for a bug in Xos.h on some systems, on which it requires
208 time.h. On some such systems, Xos.h tries to redefine struct
209 timeval and struct timezone if USG is #defined while it is
212 #ifdef XOS_NEEDS_TIME_H
218 #else /* not XOS_NEEDS_TIME_H */
220 #endif /* not XOS_NEEDS_TIME_H */
222 #endif /* HAVE_X_WINDOWS */
226 #include "keyboard.h"
229 #define max(A, B) ((A) > (B) ? (A) : (B))
230 #define min(A, B) ((A) < (B) ? (A) : (B))
231 #define abs(X) ((X) < 0 ? -(X) : (X))
234 /* Non-zero if face attribute ATTR is unspecified. */
236 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
238 /* Value is the number of elements of VECTOR. */
240 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
242 /* Make a copy of string S on the stack using alloca. Value is a pointer
245 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
247 /* Make a copy of the contents of Lisp string S on the stack using
248 alloca. Value is a pointer to the copy. */
250 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
252 /* Size of hash table of realized faces in face caches (should be a
255 #define FACE_CACHE_BUCKETS_SIZE 1001
257 /* A definition of XColor for non-X frames. */
258 #ifndef HAVE_X_WINDOWS
261 unsigned short red
, green
, blue
;
267 /* Keyword symbols used for face attribute names. */
269 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
270 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
271 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
272 Lisp_Object QCreverse_video
;
273 Lisp_Object QCoverline
, QCstrike_through
, QCbox
;
275 /* Symbols used for attribute values. */
277 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
278 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
279 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
280 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
281 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
282 Lisp_Object Qultra_expanded
;
283 Lisp_Object Qreleased_button
, Qpressed_button
;
284 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
285 Lisp_Object Qunspecified
, Qunspecified_fg
, Qunspecified_bg
;
287 /* The symbol `x-charset-registry'. This property of charsets defines
288 the X registry and encoding that fonts should have that are used to
289 display characters of that charset. */
291 Lisp_Object Qx_charset_registry
;
293 /* The name of the function to call when the background of the frame
294 has changed, frame_update_face_colors. */
296 Lisp_Object Qframe_update_face_colors
;
298 /* Names of basic faces. */
300 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
301 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
302 extern Lisp_Object Qmode_line
;
304 /* The symbol `face-alias'. A symbols having that property is an
305 alias for another face. Value of the property is the name of
308 Lisp_Object Qface_alias
;
310 /* Names of frame parameters related to faces. */
312 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
313 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
315 /* Default stipple pattern used on monochrome displays. This stipple
316 pattern is used on monochrome displays instead of shades of gray
317 for a face background color. See `set-face-stipple' for possible
318 values for this variable. */
320 Lisp_Object Vface_default_stipple
;
322 /* Default registry and encoding to use for charsets whose charset
323 symbols don't specify one. */
325 Lisp_Object Vface_default_registry
;
327 /* Alist of alternative font families. Each element is of the form
328 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
329 try FAMILY1, then FAMILY2, ... */
331 Lisp_Object Vface_alternative_font_family_alist
;
333 /* Allowed scalable fonts. A value of nil means don't allow any
334 scalable fonts. A value of t means allow the use of any scalable
335 font. Otherwise, value must be a list of regular expressions. A
336 font may be scaled if its name matches a regular expression in the
340 Lisp_Object Vscalable_fonts_allowed
;
343 /* Maximum number of fonts to consider in font_list. If not an
344 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
346 Lisp_Object Vfont_list_limit
;
347 #define DEFAULT_FONT_LIST_LIMIT 100
349 /* The symbols `foreground-color' and `background-color' which can be
350 used as part of a `face' property. This is for compatibility with
353 Lisp_Object Qforeground_color
, Qbackground_color
;
355 /* The symbols `face' and `mouse-face' used as text properties. */
358 extern Lisp_Object Qmouse_face
;
360 /* Error symbol for wrong_type_argument in load_pixmap. */
362 Lisp_Object Qbitmap_spec_p
;
364 /* Alist of global face definitions. Each element is of the form
365 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
366 is a Lisp vector of face attributes. These faces are used
367 to initialize faces for new frames. */
369 Lisp_Object Vface_new_frame_defaults
;
371 /* The next ID to assign to Lisp faces. */
373 static int next_lface_id
;
375 /* A vector mapping Lisp face Id's to face names. */
377 static Lisp_Object
*lface_id_to_name
;
378 static int lface_id_to_name_size
;
380 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
381 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
383 /* Counter for calls to clear_face_cache. If this counter reaches
384 CLEAR_FONT_TABLE_COUNT, and a frame has more than
385 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
387 static int clear_font_table_count
;
388 #define CLEAR_FONT_TABLE_COUNT 100
389 #define CLEAR_FONT_TABLE_NFONTS 10
391 /* Non-zero means face attributes have been changed since the last
392 redisplay. Used in redisplay_internal. */
394 int face_change_count
;
396 /* The total number of colors currently allocated. */
399 static int ncolors_allocated
;
400 static int npixmaps_allocated
;
406 /* Function prototypes. */
411 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
412 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
413 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
414 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
416 static int first_font_matching
P_ ((struct frame
*f
, char *,
417 struct font_name
*));
418 static int x_face_list_fonts
P_ ((struct frame
*, char *,
419 struct font_name
*, int, int, int));
420 static int font_scalable_p
P_ ((struct font_name
*));
421 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
422 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
423 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
424 static char *xstrdup
P_ ((char *));
425 static unsigned char *xstrlwr
P_ ((unsigned char *));
426 static void signal_error
P_ ((char *, Lisp_Object
));
427 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
428 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
429 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
430 static void free_face_colors
P_ ((struct frame
*, struct face
*));
431 static int face_color_gray_p
P_ ((struct frame
*, char *));
432 static char *build_font_name
P_ ((struct font_name
*));
433 static void free_font_names
P_ ((struct font_name
*, int));
434 static int sorted_font_list
P_ ((struct frame
*, char *,
435 int (*cmpfn
) P_ ((const void *, const void *)),
436 struct font_name
**));
437 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
438 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
439 struct font_name
**));
440 static int cmp_font_names
P_ ((const void *, const void *));
441 static struct face
*realize_face
P_ ((struct face_cache
*,
442 Lisp_Object
*, int));
443 static struct face
*realize_x_face
P_ ((struct face_cache
*,
444 Lisp_Object
*, int));
445 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
446 Lisp_Object
*, int));
447 static int realize_basic_faces
P_ ((struct frame
*));
448 static int realize_default_face
P_ ((struct frame
*));
449 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
450 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
451 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
452 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
453 static unsigned lface_hash
P_ ((Lisp_Object
*));
454 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
455 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
456 static void free_realized_face
P_ ((struct frame
*, struct face
*));
457 static void clear_face_gcs
P_ ((struct face_cache
*));
458 static void free_face_cache
P_ ((struct face_cache
*));
459 static int face_numeric_weight
P_ ((Lisp_Object
));
460 static int face_numeric_slant
P_ ((Lisp_Object
));
461 static int face_numeric_swidth
P_ ((Lisp_Object
));
462 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
463 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
465 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
467 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
468 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
470 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
472 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
473 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
474 static void free_realized_faces
P_ ((struct face_cache
*));
475 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
476 struct font_name
*, int));
477 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
478 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
479 static int xlfd_numeric_slant
P_ ((struct font_name
*));
480 static int xlfd_numeric_weight
P_ ((struct font_name
*));
481 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
482 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
483 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
484 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
485 static int xlfd_fixed_p
P_ ((struct font_name
*));
486 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
488 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
489 struct font_name
*, int, int));
490 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
491 struct font_name
*, int));
493 #ifdef HAVE_X_WINDOWS
495 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
496 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
497 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
498 int (*cmpfn
) P_ ((const void *, const void *))));
499 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
500 static void x_free_gc
P_ ((struct frame
*, GC
));
501 static void clear_font_table
P_ ((struct frame
*));
503 #endif /* HAVE_X_WINDOWS */
506 /***********************************************************************
508 ***********************************************************************/
510 #ifdef HAVE_X_WINDOWS
512 /* Create and return a GC for use on frame F. GC values and mask
513 are given by XGCV and MASK. */
516 x_create_gc (f
, mask
, xgcv
)
523 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
530 /* Free GC which was used on frame F. */
538 xassert (--ngcs
>= 0);
539 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
543 #endif /* HAVE_X_WINDOWS */
546 /* Like strdup, but uses xmalloc. */
552 int len
= strlen (s
) + 1;
553 char *p
= (char *) xmalloc (len
);
559 /* Like stricmp. Used to compare parts of font names which are in
564 unsigned char *s1
, *s2
;
568 unsigned char c1
= tolower (*s1
);
569 unsigned char c2
= tolower (*s2
);
571 return c1
< c2
? -1 : 1;
576 return *s2
== 0 ? 0 : -1;
581 /* Like strlwr, which might not always be available. */
583 static unsigned char *
587 unsigned char *p
= s
;
596 /* Signal `error' with message S, and additional argument ARG. */
599 signal_error (s
, arg
)
603 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
607 /* If FRAME is nil, return a pointer to the selected frame.
608 Otherwise, check that FRAME is a live frame, and return a pointer
609 to it. NPARAM is the parameter number of FRAME, for
610 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
611 Lisp function definitions. */
613 static INLINE
struct frame
*
614 frame_or_selected_frame (frame
, nparam
)
619 frame
= selected_frame
;
621 CHECK_LIVE_FRAME (frame
, nparam
);
622 return XFRAME (frame
);
626 /***********************************************************************
628 ***********************************************************************/
630 /* Initialize face cache and basic faces for frame F. */
636 /* Make a face cache, if F doesn't have one. */
637 if (FRAME_FACE_CACHE (f
) == NULL
)
638 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
640 #ifdef HAVE_X_WINDOWS
641 /* Make the image cache. */
644 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
645 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
646 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
648 #endif /* HAVE_X_WINDOWS */
650 /* Realize basic faces. Must have enough information in frame
651 parameters to realize basic faces at this point. */
652 #ifdef HAVE_X_WINDOWS
653 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
655 if (!realize_basic_faces (f
))
660 /* Free face cache of frame F. Called from Fdelete_frame. */
666 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
670 free_face_cache (face_cache
);
671 FRAME_FACE_CACHE (f
) = NULL
;
674 #ifdef HAVE_X_WINDOWS
677 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
680 --image_cache
->refcount
;
681 if (image_cache
->refcount
== 0)
682 free_image_cache (f
);
685 #endif /* HAVE_X_WINDOWS */
689 /* Clear face caches, and recompute basic faces for frame F. Call
690 this after changing frame parameters on which those faces depend,
691 or when realized faces have been freed due to changing attributes
695 recompute_basic_faces (f
)
698 if (FRAME_FACE_CACHE (f
))
700 clear_face_cache (0);
701 if (!realize_basic_faces (f
))
707 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
708 try to free unused fonts, too. */
711 clear_face_cache (clear_fonts_p
)
714 #ifdef HAVE_X_WINDOWS
715 Lisp_Object tail
, frame
;
719 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
721 /* From time to time see if we can unload some fonts. This also
722 frees all realized faces on all frames. Fonts needed by
723 faces will be loaded again when faces are realized again. */
724 clear_font_table_count
= 0;
726 FOR_EACH_FRAME (tail
, frame
)
730 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
732 free_all_realized_faces (frame
);
733 clear_font_table (f
);
739 /* Clear GCs of realized faces. */
740 FOR_EACH_FRAME (tail
, frame
)
745 clear_face_gcs (FRAME_FACE_CACHE (f
));
746 clear_image_cache (f
, 0);
750 #endif /* HAVE_X_WINDOWS */
754 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
755 "Clear face caches on all frames.\n\
756 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
758 Lisp_Object thorougly
;
760 clear_face_cache (!NILP (thorougly
));
766 #ifdef HAVE_X_WINDOWS
769 /* Remove those fonts from the font table of frame F that are not used
770 by fontsets. Called from clear_face_cache from time to time. */
776 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
778 Lisp_Object rest
, frame
;
781 xassert (FRAME_X_P (f
));
783 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
784 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
786 /* For all frames with the same x_display_info as F, record
787 in `used' those fonts that are in use by fontsets. */
788 FOR_EACH_FRAME (rest
, frame
)
789 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
791 struct frame
*f
= XFRAME (frame
);
792 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
794 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
796 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
799 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
801 int idx
= info
->font_indexes
[j
];
808 /* Free those fonts that are not used by fontsets. */
809 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
810 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
812 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
814 /* Free names. In xfns.c there is a comment that full_name
815 should never be freed because it is always shared with
816 something else. I don't think this is true anymore---see
817 x_load_font. It's either equal to font_info->name or
818 allocated via xmalloc, and there seems to be no place in
819 the source files where full_name is transferred to another
821 if (font_info
->full_name
!= font_info
->name
)
822 xfree (font_info
->full_name
);
823 xfree (font_info
->name
);
827 XFreeFont (dpyinfo
->display
, font_info
->font
);
830 /* Mark font table slot free. */
831 font_info
->font
= NULL
;
832 font_info
->name
= font_info
->full_name
= NULL
;
837 #endif /* HAVE_X_WINDOWS */
841 /***********************************************************************
843 ***********************************************************************/
845 #ifdef HAVE_X_WINDOWS
847 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
848 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
849 A bitmap specification is either a string, a file name, or a list\n\
850 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
851 HEIGHT is its height, and DATA is a string containing the bits of\n\
852 the pixmap. Bits are stored row by row, each row occupies\n\
853 (WIDTH + 7)/8 bytes.")
859 if (STRINGP (object
))
860 /* If OBJECT is a string, it's a file name. */
862 else if (CONSP (object
))
864 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
865 HEIGHT must be integers > 0, and DATA must be string large
866 enough to hold a bitmap of the specified size. */
867 Lisp_Object width
, height
, data
;
869 height
= width
= data
= Qnil
;
873 width
= XCAR (object
);
874 object
= XCDR (object
);
877 height
= XCAR (object
);
878 object
= XCDR (object
);
880 data
= XCAR (object
);
884 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
886 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
888 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
893 return pixmap_p
? Qt
: Qnil
;
897 /* Load a bitmap according to NAME (which is either a file name or a
898 pixmap spec) for use on frame F. Value is the bitmap_id (see
899 xfns.c). If NAME is nil, return with a bitmap id of zero. If
900 bitmap cannot be loaded, display a message saying so, and return
901 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
902 if these pointers are not null. */
905 load_pixmap (f
, name
, w_ptr
, h_ptr
)
908 unsigned int *w_ptr
, *h_ptr
;
916 tem
= Fbitmap_spec_p (name
);
918 wrong_type_argument (Qbitmap_spec_p
, name
);
923 /* Decode a bitmap spec into a bitmap. */
928 w
= XINT (Fcar (name
));
929 h
= XINT (Fcar (Fcdr (name
)));
930 bits
= Fcar (Fcdr (Fcdr (name
)));
932 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
937 /* It must be a string -- a file name. */
938 bitmap_id
= x_create_bitmap_from_file (f
, name
);
944 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
955 ++npixmaps_allocated
;
958 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
961 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
967 #endif /* HAVE_X_WINDOWS */
971 /***********************************************************************
973 ***********************************************************************/
975 #ifdef HAVE_X_WINDOWS
977 /* Update the line_height of frame F. Return non-zero if line height
981 frame_update_line_height (f
)
984 int fontset
, line_height
, changed_p
;
986 fontset
= f
->output_data
.x
->fontset
;
988 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
990 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
992 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
993 f
->output_data
.x
->line_height
= line_height
;
997 #endif /* HAVE_X_WINDOWS */
1000 /***********************************************************************
1002 ***********************************************************************/
1004 #ifdef HAVE_X_WINDOWS
1006 /* Load font or fontset of face FACE which is used on frame F.
1007 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1008 fontset. FONT_NAME is the name of the font to load, if no fontset
1009 is used. It is null if no suitable font name could be determined
1013 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1019 struct font_info
*font_info
= NULL
;
1021 face
->font_info_id
= -1;
1022 face
->fontset
= fontset
;
1027 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1030 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1039 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1040 face
->font
= font_info
->font
;
1041 face
->font_name
= font_info
->full_name
;
1043 /* Make the registry part of the font name readily accessible.
1044 The registry is used to find suitable faces for unibyte text. */
1045 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1047 while (i
< 2 && --s
>= font_info
->full_name
)
1051 if (!STRINGP (face
->registry
)
1052 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1054 if (STRINGP (Vface_default_registry
)
1055 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1056 face
->registry
= Vface_default_registry
;
1058 face
->registry
= build_string (s
+ 1);
1061 else if (fontset
>= 0)
1062 add_to_log ("Unable to load ASCII font of fontset %d",
1063 make_number (fontset
), Qnil
);
1065 add_to_log ("Unable to load font %s",
1066 build_string (font_name
), Qnil
);
1069 #endif /* HAVE_X_WINDOWS */
1073 /***********************************************************************
1075 ***********************************************************************/
1077 /* A version of defined_color for non-X frames. */
1079 tty_defined_color (f
, color_name
, color_def
, alloc
)
1085 Lisp_Object color_desc
;
1086 int color_idx
= FACE_TTY_DEFAULT_COLOR
, red
= 0, green
= 0, blue
= 0;
1089 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1093 XSETFRAME (frame
, f
);
1095 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1096 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1098 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1099 if (CONSP (XCDR (XCDR (color_desc
))))
1101 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1102 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1103 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1107 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1108 /* We were called early during startup, and the colors are not
1109 yet set up in tty-defined-color-alist. Don't return a failure
1110 indication, since this produces the annoying "Unable to
1111 load color" messages in the *Messages* buffer. */
1114 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1116 if (strcmp (color_name
, "unspecified-fg") == 0)
1117 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1118 else if (strcmp (color_name
, "unspecified-bg") == 0)
1119 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1122 color_def
->pixel
= (unsigned long) color_idx
;
1123 color_def
->red
= red
;
1124 color_def
->green
= green
;
1125 color_def
->blue
= blue
;
1130 /* Decide if color named COLOR is valid for the display associated
1131 with the frame F; if so, return the rgb values in COLOR_DEF. If
1132 ALLOC is nonzero, allocate a new colormap cell.
1134 This does the right thing for any type of frame. */
1136 defined_color (f
, color_name
, color_def
, alloc
)
1142 if (!FRAME_WINDOW_P (f
))
1143 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1144 #ifdef HAVE_X_WINDOWS
1145 else if (FRAME_X_P (f
))
1146 return x_defined_color (f
, color_name
, color_def
, alloc
);
1149 else if (FRAME_W32_P (f
))
1150 /* FIXME: w32_defined_color doesn't exist! w32fns.c defines
1151 defined_color which needs to be renamed, and the declaration
1152 of color_def therein should be changed. */
1153 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1156 else if (FRAME_MAC_P (f
))
1157 /* FIXME: mac_defined_color doesn't exist! */
1158 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1164 /* Given the index of the tty color, return its name, a Lisp string. */
1167 tty_color_name (f
, idx
)
1173 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1176 Lisp_Object coldesc
;
1178 XSETFRAME (frame
, f
);
1179 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1181 if (!NILP (coldesc
))
1182 return XCAR (coldesc
);
1185 /* We can have an MSDOG frame under -nw for a short window of
1186 opportunity before internal_terminal_init is called. DTRT. */
1187 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1188 return msdos_stdcolor_name (idx
);
1192 /* FIXME: When/if w32 supports colors in non-window mode, there should
1193 be a call here to a w32-specific function that returns the color
1194 by index using the default color mapping on a Windows console. */
1198 idx
== FACE_TTY_DEFAULT_FG_COLOR
? Qunspecified_fg
1199 : idx
== FACE_TTY_DEFAULT_BG_COLOR
? Qunspecified_bg
1203 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1204 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1207 face_color_gray_p (f
, color_name
)
1214 if (defined_color (f
, color_name
, &color
, 0))
1215 gray_p
= ((abs (color
.red
- color
.green
)
1216 < max (color
.red
, color
.green
) / 20)
1217 && (abs (color
.green
- color
.blue
)
1218 < max (color
.green
, color
.blue
) / 20)
1219 && (abs (color
.blue
- color
.red
)
1220 < max (color
.blue
, color
.red
) / 20));
1228 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1229 BACKGROUND_P non-zero means the color will be used as background
1233 face_color_supported_p (f
, color_name
, background_p
)
1241 XSETFRAME (frame
, f
);
1242 return (FRAME_WINDOW_P (f
)
1243 ? (!NILP (Fxw_display_color_p (frame
))
1244 || xstricmp (color_name
, "black") == 0
1245 || xstricmp (color_name
, "white") == 0
1247 && face_color_gray_p (f
, color_name
))
1248 || (!NILP (Fx_display_grayscale_p (frame
))
1249 && face_color_gray_p (f
, color_name
)))
1250 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1254 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1255 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1256 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1257 If FRAME is nil or omitted, use the selected frame.")
1259 Lisp_Object color
, frame
;
1263 CHECK_FRAME (frame
, 0);
1264 CHECK_STRING (color
, 0);
1266 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1270 DEFUN ("color-supported-p", Fcolor_supported_p
,
1271 Scolor_supported_p
, 2, 3, 0,
1272 "Return non-nil if COLOR can be displayed on FRAME.\n\
1273 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1274 If FRAME is nil or omitted, use the selected frame.\n\
1275 COLOR must be a valid color name.")
1276 (color
, frame
, background_p
)
1277 Lisp_Object frame
, color
, background_p
;
1281 CHECK_FRAME (frame
, 0);
1282 CHECK_STRING (color
, 0);
1284 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1289 /* Load color with name NAME for use by face FACE on frame F.
1290 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1291 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1292 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1293 pixel color. If color cannot be loaded, display a message, and
1294 return the foreground, background or underline color of F, but
1295 record that fact in flags of the face so that we don't try to free
1299 load_color (f
, face
, name
, target_index
)
1303 enum lface_attribute_index target_index
;
1307 xassert (STRINGP (name
));
1308 xassert (target_index
== LFACE_FOREGROUND_INDEX
1309 || target_index
== LFACE_BACKGROUND_INDEX
1310 || target_index
== LFACE_UNDERLINE_INDEX
1311 || target_index
== LFACE_OVERLINE_INDEX
1312 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1313 || target_index
== LFACE_BOX_INDEX
);
1315 /* if the color map is full, defined_color will return a best match
1316 to the values in an existing cell. */
1317 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1319 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1321 switch (target_index
)
1323 case LFACE_FOREGROUND_INDEX
:
1324 face
->foreground_defaulted_p
= 1;
1325 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1328 case LFACE_BACKGROUND_INDEX
:
1329 face
->background_defaulted_p
= 1;
1330 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1333 case LFACE_UNDERLINE_INDEX
:
1334 face
->underline_defaulted_p
= 1;
1335 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1338 case LFACE_OVERLINE_INDEX
:
1339 face
->overline_color_defaulted_p
= 1;
1340 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1343 case LFACE_STRIKE_THROUGH_INDEX
:
1344 face
->strike_through_color_defaulted_p
= 1;
1345 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1348 case LFACE_BOX_INDEX
:
1349 face
->box_color_defaulted_p
= 1;
1350 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1359 ++ncolors_allocated
;
1365 #ifdef HAVE_X_WINDOWS
1367 /* Load colors for face FACE which is used on frame F. Colors are
1368 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1369 of ATTRS. If the background color specified is not supported on F,
1370 try to emulate gray colors with a stipple from Vface_default_stipple. */
1373 load_face_colors (f
, face
, attrs
)
1380 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1381 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1383 /* Swap colors if face is inverse-video. */
1384 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1392 /* Check for support for foreground, not for background because
1393 face_color_supported_p is smart enough to know that grays are
1394 "supported" as background because we are supposed to use stipple
1396 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1397 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1399 x_destroy_bitmap (f
, face
->stipple
);
1400 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1401 &face
->pixmap_w
, &face
->pixmap_h
);
1404 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1405 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1409 /* Free color PIXEL on frame F. */
1412 unload_color (f
, pixel
)
1414 unsigned long pixel
;
1416 Display
*dpy
= FRAME_X_DISPLAY (f
);
1417 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1419 if (pixel
== BLACK_PIX_DEFAULT (f
)
1420 || pixel
== WHITE_PIX_DEFAULT (f
))
1425 /* If display has an immutable color map, freeing colors is not
1426 necessary and some servers don't allow it. So don't do it. */
1427 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1429 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1430 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1437 /* Free colors allocated for FACE. */
1440 free_face_colors (f
, face
)
1444 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1446 /* If display has an immutable color map, freeing colors is not
1447 necessary and some servers don't allow it. So don't do it. */
1448 if (class != StaticColor
1449 && class != StaticGray
1450 && class != TrueColor
)
1456 dpy
= FRAME_X_DISPLAY (f
);
1457 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1459 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1460 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1461 && !face
->foreground_defaulted_p
)
1463 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1464 IF_DEBUG (--ncolors_allocated
);
1467 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1468 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1469 && !face
->background_defaulted_p
)
1471 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1472 IF_DEBUG (--ncolors_allocated
);
1475 if (face
->underline_p
1476 && !face
->underline_defaulted_p
1477 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1478 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1480 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1481 IF_DEBUG (--ncolors_allocated
);
1484 if (face
->overline_p
1485 && !face
->overline_color_defaulted_p
1486 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1487 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1489 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1490 IF_DEBUG (--ncolors_allocated
);
1493 if (face
->strike_through_p
1494 && !face
->strike_through_color_defaulted_p
1495 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1496 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1498 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1499 IF_DEBUG (--ncolors_allocated
);
1502 if (face
->box
!= FACE_NO_BOX
1503 && !face
->box_color_defaulted_p
1504 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1505 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1507 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1508 IF_DEBUG (--ncolors_allocated
);
1514 #endif /* HAVE_X_WINDOWS */
1518 /***********************************************************************
1520 ***********************************************************************/
1522 /* An enumerator for each field of an XLFD font name. */
1543 /* An enumerator for each possible slant value of a font. Taken from
1544 the XLFD specification. */
1552 XLFD_SLANT_REVERSE_ITALIC
,
1553 XLFD_SLANT_REVERSE_OBLIQUE
,
1557 /* Relative font weight according to XLFD documentation. */
1561 XLFD_WEIGHT_UNKNOWN
,
1562 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1563 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1564 XLFD_WEIGHT_LIGHT
, /* 30 */
1565 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1566 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1567 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1568 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1569 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1570 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1573 /* Relative proportionate width. */
1577 XLFD_SWIDTH_UNKNOWN
,
1578 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1579 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1580 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1581 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1582 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1583 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1584 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1585 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1586 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1589 /* Structure used for tables mapping XLFD weight, slant, and width
1590 names to numeric and symbolic values. */
1596 Lisp_Object
*symbol
;
1599 /* Table of XLFD slant names and their numeric and symbolic
1600 representations. This table must be sorted by slant names in
1603 static struct table_entry slant_table
[] =
1605 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1606 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1607 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1608 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1609 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1610 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1613 /* Table of XLFD weight names. This table must be sorted by weight
1614 names in ascending order. */
1616 static struct table_entry weight_table
[] =
1618 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1619 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1620 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1621 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1622 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1623 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1624 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1625 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1626 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1627 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1628 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1629 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1630 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1631 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1632 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1635 /* Table of XLFD width names. This table must be sorted by width
1636 names in ascending order. */
1638 static struct table_entry swidth_table
[] =
1640 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1641 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1642 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1643 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1644 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1645 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1646 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1647 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1648 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1649 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1650 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1651 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1652 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1653 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1654 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1657 /* Structure used to hold the result of splitting font names in XLFD
1658 format into their fields. */
1662 /* The original name which is modified destructively by
1663 split_font_name. The pointer is kept here to be able to free it
1664 if it was allocated from the heap. */
1667 /* Font name fields. Each vector element points into `name' above.
1668 Fields are NUL-terminated. */
1669 char *fields
[XLFD_LAST
];
1671 /* Numeric values for those fields that interest us. See
1672 split_font_name for which these are. */
1673 int numeric
[XLFD_LAST
];
1676 /* The frame in effect when sorting font names. Set temporarily in
1677 sort_fonts so that it is available in font comparison functions. */
1679 static struct frame
*font_frame
;
1681 /* Order by which font selection chooses fonts. The default values
1682 mean `first, find a best match for the font width, then for the
1683 font height, then for weight, then for slant.' This variable can be
1684 set via set-face-font-sort-order. */
1686 static int font_sort_order
[4];
1689 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1690 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1691 is a pointer to the matching table entry or null if no table entry
1694 static struct table_entry
*
1695 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1696 struct table_entry
*table
;
1698 struct font_name
*font
;
1701 /* Function split_font_name converts fields to lower-case, so there
1702 is no need to use xstrlwr or xstricmp here. */
1703 char *s
= font
->fields
[field_index
];
1704 int low
, mid
, high
, cmp
;
1711 mid
= (low
+ high
) / 2;
1712 cmp
= strcmp (table
[mid
].name
, s
);
1726 /* Return a numeric representation for font name field
1727 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1728 has DIM entries. Value is the numeric value found or DFLT if no
1729 table entry matches. This function is used to translate weight,
1730 slant, and swidth names of XLFD font names to numeric values. */
1733 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1734 struct table_entry
*table
;
1736 struct font_name
*font
;
1740 struct table_entry
*p
;
1741 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1742 return p
? p
->numeric
: dflt
;
1746 /* Return a symbolic representation for font name field
1747 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1748 has DIM entries. Value is the symbolic value found or DFLT if no
1749 table entry matches. This function is used to translate weight,
1750 slant, and swidth names of XLFD font names to symbols. */
1752 static INLINE Lisp_Object
1753 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1754 struct table_entry
*table
;
1756 struct font_name
*font
;
1760 struct table_entry
*p
;
1761 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1762 return p
? *p
->symbol
: dflt
;
1766 /* Return a numeric value for the slant of the font given by FONT. */
1769 xlfd_numeric_slant (font
)
1770 struct font_name
*font
;
1772 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1773 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1777 /* Return a symbol representing the weight of the font given by FONT. */
1779 static INLINE Lisp_Object
1780 xlfd_symbolic_slant (font
)
1781 struct font_name
*font
;
1783 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1784 font
, XLFD_SLANT
, Qnormal
);
1788 /* Return a numeric value for the weight of the font given by FONT. */
1791 xlfd_numeric_weight (font
)
1792 struct font_name
*font
;
1794 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1795 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1799 /* Return a symbol representing the slant of the font given by FONT. */
1801 static INLINE Lisp_Object
1802 xlfd_symbolic_weight (font
)
1803 struct font_name
*font
;
1805 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1806 font
, XLFD_WEIGHT
, Qnormal
);
1810 /* Return a numeric value for the swidth of the font whose XLFD font
1811 name fields are found in FONT. */
1814 xlfd_numeric_swidth (font
)
1815 struct font_name
*font
;
1817 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1818 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1822 /* Return a symbolic value for the swidth of FONT. */
1824 static INLINE Lisp_Object
1825 xlfd_symbolic_swidth (font
)
1826 struct font_name
*font
;
1828 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1829 font
, XLFD_SWIDTH
, Qnormal
);
1833 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1834 entries. Value is a pointer to the matching table entry or null if
1835 no element of TABLE contains SYMBOL. */
1837 static struct table_entry
*
1838 face_value (table
, dim
, symbol
)
1839 struct table_entry
*table
;
1845 xassert (SYMBOLP (symbol
));
1847 for (i
= 0; i
< dim
; ++i
)
1848 if (EQ (*table
[i
].symbol
, symbol
))
1851 return i
< dim
? table
+ i
: NULL
;
1855 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1856 entries. Value is -1 if SYMBOL is not found in TABLE. */
1859 face_numeric_value (table
, dim
, symbol
)
1860 struct table_entry
*table
;
1864 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1865 return p
? p
->numeric
: -1;
1869 /* Return a numeric value representing the weight specified by Lisp
1870 symbol WEIGHT. Value is one of the enumerators of enum
1874 face_numeric_weight (weight
)
1877 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1881 /* Return a numeric value representing the slant specified by Lisp
1882 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1885 face_numeric_slant (slant
)
1888 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1892 /* Return a numeric value representing the swidth specified by Lisp
1893 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1896 face_numeric_swidth (width
)
1899 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1903 #ifdef HAVE_X_WINDOWS
1905 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1909 struct font_name
*font
;
1911 /* Function split_font_name converts fields to lower-case, so there
1912 is no need to use tolower here. */
1913 return *font
->fields
[XLFD_SPACING
] != 'p';
1917 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1919 The actual height of the font when displayed on F depends on the
1920 resolution of both the font and frame. For example, a 10pt font
1921 designed for a 100dpi display will display larger than 10pt on a
1922 75dpi display. (It's not unusual to use fonts not designed for the
1923 display one is using. For example, some intlfonts are available in
1924 72dpi versions, only.)
1926 Value is the real point size of FONT on frame F, or 0 if it cannot
1930 xlfd_point_size (f
, font
)
1932 struct font_name
*font
;
1934 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1935 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1936 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1939 if (font_resy
== 0 || font_pt
== 0)
1942 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1948 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1949 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1950 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1951 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1952 zero if the font name doesn't have the format we expect. The
1953 expected format is a font name that starts with a `-' and has
1954 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1955 forms of font names where certain field contents are enclosed in
1956 square brackets. We don't support that, for now. */
1959 split_font_name (f
, font
, numeric_p
)
1961 struct font_name
*font
;
1967 if (*font
->name
== '-')
1969 char *p
= xstrlwr (font
->name
) + 1;
1971 while (i
< XLFD_LAST
)
1973 font
->fields
[i
] = p
;
1976 while (*p
&& *p
!= '-')
1986 success_p
= i
== XLFD_LAST
;
1988 /* If requested, and font name was in the expected format,
1989 compute numeric values for some fields. */
1990 if (numeric_p
&& success_p
)
1992 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1993 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1994 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1995 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
1996 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2003 /* Build an XLFD font name from font name fields in FONT. Value is a
2004 pointer to the font name, which is allocated via xmalloc. */
2007 build_font_name (font
)
2008 struct font_name
*font
;
2012 char *font_name
= (char *) xmalloc (size
);
2013 int total_length
= 0;
2015 for (i
= 0; i
< XLFD_LAST
; ++i
)
2017 /* Add 1 because of the leading `-'. */
2018 int len
= strlen (font
->fields
[i
]) + 1;
2020 /* Reallocate font_name if necessary. Add 1 for the final
2022 if (total_length
+ len
+ 1 >= size
)
2024 int new_size
= max (2 * size
, size
+ len
+ 1);
2025 int sz
= new_size
* sizeof *font_name
;
2026 font_name
= (char *) xrealloc (font_name
, sz
);
2030 font_name
[total_length
] = '-';
2031 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2032 total_length
+= len
;
2035 font_name
[total_length
] = 0;
2040 /* Free an array FONTS of N font_name structures. This frees FONTS
2041 itself and all `name' fields in its elements. */
2044 free_font_names (fonts
, n
)
2045 struct font_name
*fonts
;
2049 xfree (fonts
[--n
].name
);
2054 /* Sort vector FONTS of font_name structures which contains NFONTS
2055 elements using qsort and comparison function CMPFN. F is the frame
2056 on which the fonts will be used. The global variable font_frame
2057 is temporarily set to F to make it available in CMPFN. */
2060 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2062 struct font_name
*fonts
;
2064 int (*cmpfn
) P_ ((const void *, const void *));
2067 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2072 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2073 display in x_display_list. FONTS is a pointer to a vector of
2074 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2075 alternative patterns from Valternate_fontname_alist if no fonts are
2076 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2079 For all fonts found, set FONTS[i].name to the name of the font,
2080 allocated via xmalloc, and split font names into fields. Ignore
2081 fonts that we can't parse. Value is the number of fonts found.
2083 This is similar to x_list_fonts. The differences are:
2085 1. It avoids consing.
2086 2. It never calls XLoadQueryFont. */
2089 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2093 struct font_name
*fonts
;
2094 int nfonts
, try_alternatives_p
;
2095 int scalable_fonts_p
;
2097 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2101 /* Get the list of fonts matching PATTERN from the X server. */
2103 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2108 /* Make a copy of the font names we got from X, and
2109 split them into fields. */
2110 for (i
= j
= 0; i
< n
; ++i
)
2112 /* Make a copy of the font name. */
2113 fonts
[j
].name
= xstrdup (names
[i
]);
2115 /* Ignore fonts having a name that we can't parse. */
2116 if (!split_font_name (f
, fonts
+ j
, 1))
2117 xfree (fonts
[j
].name
);
2118 else if (font_scalable_p (fonts
+ j
))
2121 if (!scalable_fonts_p
2122 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2123 xfree (fonts
[j
].name
);
2126 #else /* !SCALABLE_FONTS */
2127 /* Always ignore scalable fonts. */
2128 xfree (fonts
[j
].name
);
2129 #endif /* !SCALABLE_FONTS */
2137 /* Free font names. */
2139 XFreeFontNames (names
);
2144 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2145 if (n
== 0 && try_alternatives_p
)
2147 Lisp_Object list
= Valternate_fontname_alist
;
2149 while (CONSP (list
))
2151 Lisp_Object entry
= XCAR (list
);
2153 && STRINGP (XCAR (entry
))
2154 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2161 Lisp_Object patterns
= XCAR (list
);
2164 while (CONSP (patterns
)
2165 /* If list is screwed up, give up. */
2166 && (name
= XCAR (patterns
),
2168 /* Ignore patterns equal to PATTERN because we tried that
2169 already with no success. */
2170 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2171 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2175 patterns
= XCDR (patterns
);
2183 /* Determine the first font matching PATTERN on frame F. Return in
2184 *FONT the matching font name, split into fields. Value is non-zero
2185 if a match was found. */
2188 first_font_matching (f
, pattern
, font
)
2191 struct font_name
*font
;
2194 struct font_name
*fonts
;
2196 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2197 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2201 bcopy (&fonts
[0], font
, sizeof *font
);
2203 fonts
[0].name
= NULL
;
2204 free_font_names (fonts
, nfonts
);
2211 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2212 using comparison function CMPFN. Value is the number of fonts
2213 found. If value is non-zero, *FONTS is set to a vector of
2214 font_name structures allocated from the heap containing matching
2215 fonts. Each element of *FONTS contains a name member that is also
2216 allocated from the heap. Font names in these structures are split
2217 into fields. Use free_font_names to free such an array. */
2220 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2223 int (*cmpfn
) P_ ((const void *, const void *));
2224 struct font_name
**fonts
;
2228 /* Get the list of fonts matching pattern. 100 should suffice. */
2229 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2230 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2231 nfonts
= XFASTINT (Vfont_list_limit
);
2233 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2235 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2237 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2240 /* Sort the resulting array and return it in *FONTS. If no
2241 fonts were found, make sure to set *FONTS to null. */
2243 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2254 /* Compare two font_name structures *A and *B. Value is analogous to
2255 strcmp. Sort order is given by the global variable
2256 font_sort_order. Font names are sorted so that, everything else
2257 being equal, fonts with a resolution closer to that of the frame on
2258 which they are used are listed first. The global variable
2259 font_frame is the frame on which we operate. */
2262 cmp_font_names (a
, b
)
2265 struct font_name
*x
= (struct font_name
*) a
;
2266 struct font_name
*y
= (struct font_name
*) b
;
2269 /* All strings have been converted to lower-case by split_font_name,
2270 so we can use strcmp here. */
2271 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2276 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2278 int j
= font_sort_order
[i
];
2279 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2284 /* Everything else being equal, we prefer fonts with an
2285 y-resolution closer to that of the frame. */
2286 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2287 int x_resy
= x
->numeric
[XLFD_RESY
];
2288 int y_resy
= y
->numeric
[XLFD_RESY
];
2289 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2297 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2298 is non-null list fonts matching that pattern. Otherwise, if
2299 REGISTRY_AND_ENCODING is non-null return only fonts with that
2300 registry and encoding, otherwise return fonts of any registry and
2301 encoding. Set *FONTS to a vector of font_name structures allocated
2302 from the heap containing the fonts found. Value is the number of
2306 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2310 char *registry_and_encoding
;
2311 struct font_name
**fonts
;
2313 if (pattern
== NULL
)
2318 if (registry_and_encoding
== NULL
)
2319 registry_and_encoding
= "*";
2321 pattern
= (char *) alloca (strlen (family
)
2322 + strlen (registry_and_encoding
)
2324 if (index (family
, '-'))
2325 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2327 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2330 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2334 /* Remove elements from LIST whose cars are `equal'. Called from
2335 x-family-fonts and x-font-family-list to remove duplicate font
2339 remove_duplicates (list
)
2342 Lisp_Object tail
= list
;
2344 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2346 Lisp_Object next
= XCDR (tail
);
2347 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2348 XCDR (tail
) = XCDR (next
);
2355 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2356 "Return a list of available fonts of family FAMILY on FRAME.\n\
2357 If FAMILY is omitted or nil, list all families.\n\
2358 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2360 If FRAME is omitted or nil, use the selected frame.\n\
2361 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2362 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2363 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2364 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2365 width, weight and slant of the font. These symbols are the same as for\n\
2366 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2367 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2368 giving the registry and encoding of the font.\n\
2369 The result list is sorted according to the current setting of\n\
2370 the face font sort order.")
2372 Lisp_Object family
, frame
;
2374 struct frame
*f
= check_x_frame (frame
);
2375 struct font_name
*fonts
;
2378 struct gcpro gcpro1
;
2379 char *family_pattern
;
2382 family_pattern
= "*";
2385 CHECK_STRING (family
, 1);
2386 family_pattern
= LSTRDUPA (family
);
2391 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2392 for (i
= nfonts
- 1; i
>= 0; --i
)
2394 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2397 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2399 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2400 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2401 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2402 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2403 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2404 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2405 tem
= build_font_name (fonts
+ i
);
2406 ASET (v
, 6, build_string (tem
));
2407 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2408 fonts
[i
].fields
[XLFD_ENCODING
]);
2409 ASET (v
, 7, build_string (tem
));
2412 result
= Fcons (v
, result
);
2417 remove_duplicates (result
);
2418 free_font_names (fonts
, nfonts
);
2424 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2426 "Return a list of available font families on FRAME.\n\
2427 If FRAME is omitted or nil, use the selected frame.\n\
2428 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2429 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2434 struct frame
*f
= check_x_frame (frame
);
2436 struct font_name
*fonts
;
2438 struct gcpro gcpro1
;
2439 int count
= specpdl_ptr
- specpdl
;
2442 /* Let's consider all fonts. Increase the limit for matching
2443 fonts until we have them all. */
2446 specbind (intern ("font-list-limit"), make_number (limit
));
2447 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2449 if (nfonts
== limit
)
2451 free_font_names (fonts
, nfonts
);
2460 for (i
= nfonts
- 1; i
>= 0; --i
)
2461 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2462 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2465 remove_duplicates (result
);
2466 free_font_names (fonts
, nfonts
);
2468 return unbind_to (count
, result
);
2472 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2473 "Return a list of the names of available fonts matching PATTERN.\n\
2474 If optional arguments FACE and FRAME are specified, return only fonts\n\
2475 the same size as FACE on FRAME.\n\
2476 PATTERN is a string, perhaps with wildcard characters;\n\
2477 the * character matches any substring, and\n\
2478 the ? character matches any single character.\n\
2479 PATTERN is case-insensitive.\n\
2480 FACE is a face name--a symbol.\n\
2482 The return value is a list of strings, suitable as arguments to\n\
2485 Fonts Emacs can't use may or may not be excluded\n\
2486 even if they match PATTERN and FACE.\n\
2487 The optional fourth argument MAXIMUM sets a limit on how many\n\
2488 fonts to match. The first MAXIMUM fonts are reported.\n\
2489 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2490 occupied by a character of a font. In that case, return only fonts\n\
2491 the WIDTH times as wide as FACE on FRAME.")
2492 (pattern
, face
, frame
, maximum
, width
)
2493 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2500 CHECK_STRING (pattern
, 0);
2506 CHECK_NATNUM (maximum
, 0);
2507 maxnames
= XINT (maximum
);
2511 CHECK_NUMBER (width
, 4);
2513 /* We can't simply call check_x_frame because this function may be
2514 called before any frame is created. */
2515 f
= frame_or_selected_frame (frame
, 2);
2518 /* Perhaps we have not yet created any frame. */
2523 /* Determine the width standard for comparison with the fonts we find. */
2529 /* This is of limited utility since it works with character
2530 widths. Keep it for compatibility. --gerd. */
2531 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2532 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2535 size
= face
->font
->max_bounds
.width
;
2537 size
= FRAME_FONT (f
)->max_bounds
.width
;
2540 size
*= XINT (width
);
2544 Lisp_Object args
[2];
2546 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2548 /* We don't have to check fontsets. */
2550 args
[1] = list_fontsets (f
, pattern
, size
);
2551 return Fnconc (2, args
);
2555 #endif /* HAVE_X_WINDOWS */
2559 /***********************************************************************
2561 ***********************************************************************/
2563 /* Access face attributes of face FACE, a Lisp vector. */
2565 #define LFACE_FAMILY(LFACE) \
2566 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2567 #define LFACE_HEIGHT(LFACE) \
2568 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2569 #define LFACE_WEIGHT(LFACE) \
2570 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2571 #define LFACE_SLANT(LFACE) \
2572 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2573 #define LFACE_UNDERLINE(LFACE) \
2574 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2575 #define LFACE_INVERSE(LFACE) \
2576 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2577 #define LFACE_FOREGROUND(LFACE) \
2578 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2579 #define LFACE_BACKGROUND(LFACE) \
2580 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2581 #define LFACE_STIPPLE(LFACE) \
2582 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2583 #define LFACE_SWIDTH(LFACE) \
2584 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2585 #define LFACE_OVERLINE(LFACE) \
2586 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2587 #define LFACE_STRIKE_THROUGH(LFACE) \
2588 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2589 #define LFACE_BOX(LFACE) \
2590 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2592 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2593 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2595 #define LFACEP(LFACE) \
2597 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2598 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2603 /* Check consistency of Lisp face attribute vector ATTRS. */
2606 check_lface_attrs (attrs
)
2609 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2610 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2611 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2612 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2613 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2614 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2615 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2616 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2617 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2618 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2619 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2620 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2621 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2622 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2623 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2624 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2625 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2626 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2627 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2628 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2629 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2630 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2631 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2632 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2633 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2634 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2635 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2636 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2637 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2638 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2639 #ifdef HAVE_WINDOW_SYSTEM
2640 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2641 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2642 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2647 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2655 xassert (LFACEP (lface
));
2656 check_lface_attrs (XVECTOR (lface
)->contents
);
2660 #else /* GLYPH_DEBUG == 0 */
2662 #define check_lface_attrs(attrs) (void) 0
2663 #define check_lface(lface) (void) 0
2665 #endif /* GLYPH_DEBUG == 0 */
2668 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2669 to make it a symvol. If FACE_NAME is an alias for another face,
2670 return that face's name. */
2673 resolve_face_name (face_name
)
2674 Lisp_Object face_name
;
2676 Lisp_Object aliased
;
2678 if (STRINGP (face_name
))
2679 face_name
= intern (XSTRING (face_name
)->data
);
2683 aliased
= Fget (face_name
, Qface_alias
);
2687 face_name
= aliased
;
2694 /* Return the face definition of FACE_NAME on frame F. F null means
2695 return the global definition. FACE_NAME may be a string or a
2696 symbol (apparently Emacs 20.2 allows strings as face names in face
2697 text properties; ediff uses that). If FACE_NAME is an alias for
2698 another face, return that face's definition. If SIGNAL_P is
2699 non-zero, signal an error if FACE_NAME is not a valid face name.
2700 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2703 static INLINE Lisp_Object
2704 lface_from_face_name (f
, face_name
, signal_p
)
2706 Lisp_Object face_name
;
2711 face_name
= resolve_face_name (face_name
);
2714 lface
= assq_no_quit (face_name
, f
->face_alist
);
2716 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2719 lface
= XCDR (lface
);
2721 signal_error ("Invalid face", face_name
);
2723 check_lface (lface
);
2728 /* Get face attributes of face FACE_NAME from frame-local faces on
2729 frame F. Store the resulting attributes in ATTRS which must point
2730 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2731 is non-zero, signal an error if FACE_NAME does not name a face.
2732 Otherwise, value is zero if FACE_NAME is not a face. */
2735 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2737 Lisp_Object face_name
;
2744 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2747 bcopy (XVECTOR (lface
)->contents
, attrs
,
2748 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2758 /* Non-zero if all attributes in face attribute vector ATTRS are
2759 specified, i.e. are non-nil. */
2762 lface_fully_specified_p (attrs
)
2767 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2768 if (UNSPECIFIEDP (attrs
[i
]))
2771 return i
== LFACE_VECTOR_SIZE
;
2775 #ifdef HAVE_X_WINDOWS
2777 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2778 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2779 LFACE. MAY_FAIL_P non-zero means return 0 if FONT_NAME isn't a
2780 valid font name; otherwise this function tries to use a reasonable
2783 Ignore fields of FONT_NAME containing wildcards. Value is zero if
2784 not successful because FONT_NAME was not in a valid format and
2785 MAY_FAIL_P was non-zero. A valid format is one that is suitable
2786 for split_font_name, see the comment there. */
2789 set_lface_from_font_name (f
, lface
, font_name
, force_p
, may_fail_p
)
2793 int force_p
, may_fail_p
;
2795 struct font_name font
;
2798 int free_font_name_p
= 0;
2799 int have_font_p
= 0;
2801 /* If FONT_NAME contains wildcards, use the first matching font. */
2802 if (index (font_name
, '*') || index (font_name
, '?'))
2804 if (first_font_matching (f
, font_name
, &font
))
2805 free_font_name_p
= have_font_p
= 1;
2809 font
.name
= STRDUPA (font_name
);
2810 if (split_font_name (f
, &font
, 1))
2814 /* The font name may be something like `6x13'. Make
2815 sure we use the full name. */
2816 struct font_info
*font_info
;
2819 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2820 CHARSET_ASCII
, font_name
, -1);
2823 font
.name
= STRDUPA (font_info
->full_name
);
2824 split_font_name (f
, &font
, 1);
2831 /* If FONT_NAME is completely bogus try to use something reasonable
2832 if this function must succeed. Otherwise, give up. */
2837 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2839 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2841 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2843 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2845 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2847 || first_font_matching (f
, "fixed", &font
))
2848 free_font_name_p
= 1;
2854 /* Set attributes only if unspecified, otherwise face defaults for
2855 new frames would never take effect. */
2857 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2859 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2860 + strlen (font
.fields
[XLFD_FOUNDRY
])
2862 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2863 font
.fields
[XLFD_FAMILY
]);
2864 LFACE_FAMILY (lface
) = build_string (buffer
);
2867 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2869 pt
= xlfd_point_size (f
, &font
);
2871 LFACE_HEIGHT (lface
) = make_number (pt
);
2874 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2875 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2877 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2878 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2880 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2881 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2883 if (free_font_name_p
)
2889 #endif /* HAVE_X_WINDOWS */
2892 /* Merge two Lisp face attribute vectors FROM and TO and store the
2893 resulting attributes in TO. Every non-nil attribute of FROM
2894 overrides the corresponding attribute of TO. */
2897 merge_face_vectors (from
, to
)
2898 Lisp_Object
*from
, *to
;
2901 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2902 if (!UNSPECIFIEDP (from
[i
]))
2907 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2908 is a face property, determine the resulting face attributes on
2909 frame F, and store them in TO. PROP may be a single face
2910 specification or a list of such specifications. Each face
2911 specification can be
2913 1. A symbol or string naming a Lisp face.
2915 2. A property list of the form (KEYWORD VALUE ...) where each
2916 KEYWORD is a face attribute name, and value is an appropriate value
2919 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2920 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2921 for compatibility with 20.2.
2923 Face specifications earlier in lists take precedence over later
2927 merge_face_vector_with_property (f
, to
, prop
)
2934 Lisp_Object first
= XCAR (prop
);
2936 if (EQ (first
, Qforeground_color
)
2937 || EQ (first
, Qbackground_color
))
2939 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2940 . COLOR). COLOR must be a string. */
2941 Lisp_Object color_name
= XCDR (prop
);
2942 Lisp_Object color
= first
;
2944 if (STRINGP (color_name
))
2946 if (EQ (color
, Qforeground_color
))
2947 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2949 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2952 add_to_log ("Invalid face color", color_name
, Qnil
);
2954 else if (SYMBOLP (first
)
2955 && *XSYMBOL (first
)->name
->data
== ':')
2957 /* Assume this is the property list form. */
2958 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2960 Lisp_Object keyword
= XCAR (prop
);
2961 Lisp_Object value
= XCAR (XCDR (prop
));
2963 if (EQ (keyword
, QCfamily
))
2965 if (STRINGP (value
))
2966 to
[LFACE_FAMILY_INDEX
] = value
;
2968 add_to_log ("Illegal face font family", value
, Qnil
);
2970 else if (EQ (keyword
, QCheight
))
2972 if (INTEGERP (value
))
2973 to
[LFACE_HEIGHT_INDEX
] = value
;
2975 add_to_log ("Illegal face font height", value
, Qnil
);
2977 else if (EQ (keyword
, QCweight
))
2980 && face_numeric_weight (value
) >= 0)
2981 to
[LFACE_WEIGHT_INDEX
] = value
;
2983 add_to_log ("Illegal face weight", value
, Qnil
);
2985 else if (EQ (keyword
, QCslant
))
2988 && face_numeric_slant (value
) >= 0)
2989 to
[LFACE_SLANT_INDEX
] = value
;
2991 add_to_log ("Illegal face slant", value
, Qnil
);
2993 else if (EQ (keyword
, QCunderline
))
2998 to
[LFACE_UNDERLINE_INDEX
] = value
;
3000 add_to_log ("Illegal face underline", value
, Qnil
);
3002 else if (EQ (keyword
, QCoverline
))
3007 to
[LFACE_OVERLINE_INDEX
] = value
;
3009 add_to_log ("Illegal face overline", value
, Qnil
);
3011 else if (EQ (keyword
, QCstrike_through
))
3016 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3018 add_to_log ("Illegal face strike-through", value
, Qnil
);
3020 else if (EQ (keyword
, QCbox
))
3023 value
= make_number (1);
3024 if (INTEGERP (value
)
3028 to
[LFACE_BOX_INDEX
] = value
;
3030 add_to_log ("Illegal face box", value
, Qnil
);
3032 else if (EQ (keyword
, QCinverse_video
)
3033 || EQ (keyword
, QCreverse_video
))
3035 if (EQ (value
, Qt
) || NILP (value
))
3036 to
[LFACE_INVERSE_INDEX
] = value
;
3038 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3040 else if (EQ (keyword
, QCforeground
))
3042 if (STRINGP (value
))
3043 to
[LFACE_FOREGROUND_INDEX
] = value
;
3045 add_to_log ("Illegal face foreground", value
, Qnil
);
3047 else if (EQ (keyword
, QCbackground
))
3049 if (STRINGP (value
))
3050 to
[LFACE_BACKGROUND_INDEX
] = value
;
3052 add_to_log ("Illegal face background", value
, Qnil
);
3054 else if (EQ (keyword
, QCstipple
))
3056 #ifdef HAVE_X_WINDOWS
3057 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3058 if (!NILP (pixmap_p
))
3059 to
[LFACE_STIPPLE_INDEX
] = value
;
3061 add_to_log ("Illegal face stipple", value
, Qnil
);
3064 else if (EQ (keyword
, QCwidth
))
3067 && face_numeric_swidth (value
) >= 0)
3068 to
[LFACE_SWIDTH_INDEX
] = value
;
3070 add_to_log ("Illegal face width", value
, Qnil
);
3073 add_to_log ("Invalid attribute %s in face property",
3076 prop
= XCDR (XCDR (prop
));
3081 /* This is a list of face specs. Specifications at the
3082 beginning of the list take precedence over later
3083 specifications, so we have to merge starting with the
3084 last specification. */
3085 Lisp_Object next
= XCDR (prop
);
3087 merge_face_vector_with_property (f
, to
, next
);
3088 merge_face_vector_with_property (f
, to
, first
);
3093 /* PROP ought to be a face name. */
3094 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3096 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3098 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3103 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3104 Sinternal_make_lisp_face
, 1, 2, 0,
3105 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3106 If FACE was not known as a face before, create a new one.\n\
3107 If optional argument FRAME is specified, make a frame-local face\n\
3108 for that frame. Otherwise operate on the global face definition.\n\
3109 Value is a vector of face attributes.")
3111 Lisp_Object face
, frame
;
3113 Lisp_Object global_lface
, lface
;
3117 CHECK_SYMBOL (face
, 0);
3118 global_lface
= lface_from_face_name (NULL
, face
, 0);
3122 CHECK_LIVE_FRAME (frame
, 1);
3124 lface
= lface_from_face_name (f
, face
, 0);
3127 f
= NULL
, lface
= Qnil
;
3129 /* Add a global definition if there is none. */
3130 if (NILP (global_lface
))
3132 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3134 XVECTOR (global_lface
)->contents
[0] = Qface
;
3135 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3136 Vface_new_frame_defaults
);
3138 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3139 face id to Lisp face is given by the vector lface_id_to_name.
3140 The mapping from Lisp face to Lisp face id is given by the
3141 property `face' of the Lisp face name. */
3142 if (next_lface_id
== lface_id_to_name_size
)
3144 int new_size
= max (50, 2 * lface_id_to_name_size
);
3145 int sz
= new_size
* sizeof *lface_id_to_name
;
3146 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3147 lface_id_to_name_size
= new_size
;
3150 lface_id_to_name
[next_lface_id
] = face
;
3151 Fput (face
, Qface
, make_number (next_lface_id
));
3155 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3156 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3158 /* Add a frame-local definition. */
3163 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3165 XVECTOR (lface
)->contents
[0] = Qface
;
3166 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3169 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3170 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3173 lface
= global_lface
;
3175 xassert (LFACEP (lface
));
3176 check_lface (lface
);
3181 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3182 Sinternal_lisp_face_p
, 1, 2, 0,
3183 "Return non-nil if FACE names a face.\n\
3184 If optional second parameter FRAME is non-nil, check for the\n\
3185 existence of a frame-local face with name FACE on that frame.\n\
3186 Otherwise check for the existence of a global face.")
3188 Lisp_Object face
, frame
;
3194 CHECK_LIVE_FRAME (frame
, 1);
3195 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3198 lface
= lface_from_face_name (NULL
, face
, 0);
3204 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3205 Sinternal_copy_lisp_face
, 4, 4, 0,
3206 "Copy face FROM to TO.\n\
3207 If FRAME it t, copy the global face definition of FROM to the\n\
3208 global face definition of TO. Otherwise, copy the frame-local\n\
3209 definition of FROM on FRAME to the frame-local definition of TO\n\
3210 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3213 (from
, to
, frame
, new_frame
)
3214 Lisp_Object from
, to
, frame
, new_frame
;
3216 Lisp_Object lface
, copy
;
3218 CHECK_SYMBOL (from
, 0);
3219 CHECK_SYMBOL (to
, 1);
3220 if (NILP (new_frame
))
3225 /* Copy global definition of FROM. We don't make copies of
3226 strings etc. because 20.2 didn't do it either. */
3227 lface
= lface_from_face_name (NULL
, from
, 1);
3228 copy
= Finternal_make_lisp_face (to
, Qnil
);
3232 /* Copy frame-local definition of FROM. */
3233 CHECK_LIVE_FRAME (frame
, 2);
3234 CHECK_LIVE_FRAME (new_frame
, 3);
3235 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3236 copy
= Finternal_make_lisp_face (to
, new_frame
);
3239 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3240 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3246 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3247 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3248 "Set attribute ATTR of FACE to VALUE.\n\
3249 If optional argument FRAME is given, set the face attribute of face FACE\n\
3250 on that frame. If FRAME is t, set the attribute of the default for face\n\
3251 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3253 (face
, attr
, value
, frame
)
3254 Lisp_Object face
, attr
, value
, frame
;
3257 Lisp_Object old_value
= Qnil
;
3258 int font_related_attr_p
= 0;
3260 CHECK_SYMBOL (face
, 0);
3261 CHECK_SYMBOL (attr
, 1);
3263 face
= resolve_face_name (face
);
3265 /* Set lface to the Lisp attribute vector of FACE. */
3267 lface
= lface_from_face_name (NULL
, face
, 1);
3271 frame
= selected_frame
;
3273 CHECK_LIVE_FRAME (frame
, 3);
3274 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3276 /* If a frame-local face doesn't exist yet, create one. */
3278 lface
= Finternal_make_lisp_face (face
, frame
);
3281 if (EQ (attr
, QCfamily
))
3283 if (!UNSPECIFIEDP (value
))
3285 CHECK_STRING (value
, 3);
3286 if (XSTRING (value
)->size
== 0)
3287 signal_error ("Invalid face family", value
);
3289 old_value
= LFACE_FAMILY (lface
);
3290 LFACE_FAMILY (lface
) = value
;
3291 font_related_attr_p
= 1;
3293 else if (EQ (attr
, QCheight
))
3295 if (!UNSPECIFIEDP (value
))
3297 CHECK_NUMBER (value
, 3);
3298 if (XINT (value
) <= 0)
3299 signal_error ("Invalid face height", value
);
3301 old_value
= LFACE_HEIGHT (lface
);
3302 LFACE_HEIGHT (lface
) = value
;
3303 font_related_attr_p
= 1;
3305 else if (EQ (attr
, QCweight
))
3307 if (!UNSPECIFIEDP (value
))
3309 CHECK_SYMBOL (value
, 3);
3310 if (face_numeric_weight (value
) < 0)
3311 signal_error ("Invalid face weight", value
);
3313 old_value
= LFACE_WEIGHT (lface
);
3314 LFACE_WEIGHT (lface
) = value
;
3315 font_related_attr_p
= 1;
3317 else if (EQ (attr
, QCslant
))
3319 if (!UNSPECIFIEDP (value
))
3321 CHECK_SYMBOL (value
, 3);
3322 if (face_numeric_slant (value
) < 0)
3323 signal_error ("Invalid face slant", value
);
3325 old_value
= LFACE_SLANT (lface
);
3326 LFACE_SLANT (lface
) = value
;
3327 font_related_attr_p
= 1;
3329 else if (EQ (attr
, QCunderline
))
3331 if (!UNSPECIFIEDP (value
))
3332 if ((SYMBOLP (value
)
3334 && !EQ (value
, Qnil
))
3335 /* Underline color. */
3337 && XSTRING (value
)->size
== 0))
3338 signal_error ("Invalid face underline", value
);
3340 old_value
= LFACE_UNDERLINE (lface
);
3341 LFACE_UNDERLINE (lface
) = value
;
3343 else if (EQ (attr
, QCoverline
))
3345 if (!UNSPECIFIEDP (value
))
3346 if ((SYMBOLP (value
)
3348 && !EQ (value
, Qnil
))
3349 /* Overline color. */
3351 && XSTRING (value
)->size
== 0))
3352 signal_error ("Invalid face overline", value
);
3354 old_value
= LFACE_OVERLINE (lface
);
3355 LFACE_OVERLINE (lface
) = value
;
3357 else if (EQ (attr
, QCstrike_through
))
3359 if (!UNSPECIFIEDP (value
))
3360 if ((SYMBOLP (value
)
3362 && !EQ (value
, Qnil
))
3363 /* Strike-through color. */
3365 && XSTRING (value
)->size
== 0))
3366 signal_error ("Invalid face strike-through", value
);
3368 old_value
= LFACE_STRIKE_THROUGH (lface
);
3369 LFACE_STRIKE_THROUGH (lface
) = value
;
3371 else if (EQ (attr
, QCbox
))
3375 /* Allow t meaning a simple box of width 1 in foreground color
3378 value
= make_number (1);
3380 if (UNSPECIFIEDP (value
))
3382 else if (NILP (value
))
3384 else if (INTEGERP (value
))
3385 valid_p
= XINT (value
) > 0;
3386 else if (STRINGP (value
))
3387 valid_p
= XSTRING (value
)->size
> 0;
3388 else if (CONSP (value
))
3404 if (EQ (k
, QCline_width
))
3406 if (!INTEGERP (v
) || XINT (v
) <= 0)
3409 else if (EQ (k
, QCcolor
))
3411 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3414 else if (EQ (k
, QCstyle
))
3416 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3423 valid_p
= NILP (tem
);
3429 signal_error ("Invalid face box", value
);
3431 old_value
= LFACE_BOX (lface
);
3432 LFACE_BOX (lface
) = value
;
3434 else if (EQ (attr
, QCinverse_video
)
3435 || EQ (attr
, QCreverse_video
))
3437 if (!UNSPECIFIEDP (value
))
3439 CHECK_SYMBOL (value
, 3);
3440 if (!EQ (value
, Qt
) && !NILP (value
))
3441 signal_error ("Invalid inverse-video face attribute value", value
);
3443 old_value
= LFACE_INVERSE (lface
);
3444 LFACE_INVERSE (lface
) = value
;
3446 else if (EQ (attr
, QCforeground
))
3448 if (!UNSPECIFIEDP (value
)
3449 && !EQ (value
, Qunspecified_fg
) && !EQ (value
, Qunspecified_bg
))
3451 /* Don't check for valid color names here because it depends
3452 on the frame (display) whether the color will be valid
3453 when the face is realized. */
3454 CHECK_STRING (value
, 3);
3455 if (XSTRING (value
)->size
== 0)
3456 signal_error ("Empty foreground color value", value
);
3458 old_value
= LFACE_FOREGROUND (lface
);
3459 LFACE_FOREGROUND (lface
) = value
;
3461 else if (EQ (attr
, QCbackground
))
3463 if (!UNSPECIFIEDP (value
)
3464 && !EQ (value
, Qunspecified_bg
) && !EQ (value
, Qunspecified_fg
))
3466 /* Don't check for valid color names here because it depends
3467 on the frame (display) whether the color will be valid
3468 when the face is realized. */
3469 CHECK_STRING (value
, 3);
3470 if (XSTRING (value
)->size
== 0)
3471 signal_error ("Empty background color value", value
);
3473 old_value
= LFACE_BACKGROUND (lface
);
3474 LFACE_BACKGROUND (lface
) = value
;
3476 else if (EQ (attr
, QCstipple
))
3478 #ifdef HAVE_X_WINDOWS
3479 if (!UNSPECIFIEDP (value
)
3481 && NILP (Fbitmap_spec_p (value
)))
3482 signal_error ("Invalid stipple attribute", value
);
3483 old_value
= LFACE_STIPPLE (lface
);
3484 LFACE_STIPPLE (lface
) = value
;
3485 #endif /* HAVE_X_WINDOWS */
3487 else if (EQ (attr
, QCwidth
))
3489 if (!UNSPECIFIEDP (value
))
3491 CHECK_SYMBOL (value
, 3);
3492 if (face_numeric_swidth (value
) < 0)
3493 signal_error ("Invalid face width", value
);
3495 old_value
= LFACE_SWIDTH (lface
);
3496 LFACE_SWIDTH (lface
) = value
;
3497 font_related_attr_p
= 1;
3499 else if (EQ (attr
, QCfont
))
3501 #ifdef HAVE_X_WINDOWS
3502 /* Set font-related attributes of the Lisp face from an
3506 CHECK_STRING (value
, 3);
3508 f
= SELECTED_FRAME ();
3510 f
= check_x_frame (frame
);
3512 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3513 signal_error ("Invalid font name", value
);
3515 font_related_attr_p
= 1;
3516 #endif /* HAVE_X_WINDOWS */
3518 else if (EQ (attr
, QCbold
))
3520 old_value
= LFACE_WEIGHT (lface
);
3521 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3522 font_related_attr_p
= 1;
3524 else if (EQ (attr
, QCitalic
))
3526 old_value
= LFACE_SLANT (lface
);
3527 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3528 font_related_attr_p
= 1;
3531 signal_error ("Invalid face attribute name", attr
);
3533 /* Changing a named face means that all realized faces depending on
3534 that face are invalid. Since we cannot tell which realized faces
3535 depend on the face, make sure they are all removed. This is done
3536 by incrementing face_change_count. The next call to
3537 init_iterator will then free realized faces. */
3539 && (EQ (attr
, QCfont
)
3540 || NILP (Fequal (old_value
, value
))))
3542 ++face_change_count
;
3543 ++windows_or_buffers_changed
;
3546 #ifdef HAVE_X_WINDOWS
3549 && !UNSPECIFIEDP (value
)
3550 && NILP (Fequal (old_value
, value
)))
3556 if (EQ (face
, Qdefault
))
3558 /* Changed font-related attributes of the `default' face are
3559 reflected in changed `font' frame parameters. */
3560 if (font_related_attr_p
3561 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3562 set_font_frame_param (frame
, lface
);
3563 else if (EQ (attr
, QCforeground
))
3564 param
= Qforeground_color
;
3565 else if (EQ (attr
, QCbackground
))
3566 param
= Qbackground_color
;
3568 else if (EQ (face
, Qscroll_bar
))
3570 /* Changing the colors of `scroll-bar' sets frame parameters
3571 `scroll-bar-foreground' and `scroll-bar-background'. */
3572 if (EQ (attr
, QCforeground
))
3573 param
= Qscroll_bar_foreground
;
3574 else if (EQ (attr
, QCbackground
))
3575 param
= Qscroll_bar_background
;
3577 else if (EQ (face
, Qborder
))
3579 /* Changing background color of `border' sets frame parameter
3581 if (EQ (attr
, QCbackground
))
3582 param
= Qborder_color
;
3584 else if (EQ (face
, Qcursor
))
3586 /* Changing background color of `cursor' sets frame parameter
3588 if (EQ (attr
, QCbackground
))
3589 param
= Qcursor_color
;
3591 else if (EQ (face
, Qmouse
))
3593 /* Changing background color of `mouse' sets frame parameter
3595 if (EQ (attr
, QCbackground
))
3596 param
= Qmouse_color
;
3599 if (SYMBOLP (param
))
3600 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3603 #endif /* HAVE_X_WINDOWS */
3609 #ifdef HAVE_X_WINDOWS
3611 /* Set the `font' frame parameter of FRAME according to `default' face
3612 attributes LFACE. */
3615 set_font_frame_param (frame
, lface
)
3616 Lisp_Object frame
, lface
;
3618 struct frame
*f
= XFRAME (frame
);
3619 Lisp_Object frame_font
;
3623 /* Get FRAME's font parameter. */
3624 frame_font
= Fassq (Qfont
, f
->param_alist
);
3625 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3626 frame_font
= XCDR (frame_font
);
3628 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3631 /* Frame parameter is a fontset name. Modify the fontset so
3632 that all its fonts reflect face attributes LFACE. */
3634 struct fontset_info
*fontset_info
;
3636 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3638 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3639 if (fontset_info
->fontname
[charset
])
3641 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3643 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3644 build_string (font
), frame
);
3650 /* Frame parameter is an X font name. I believe this can
3651 only happen in unibyte mode. */
3652 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3653 -1, Vface_default_registry
);
3656 store_frame_param (f
, Qfont
, build_string (font
));
3663 /* Update the corresponding face when frame parameter PARAM on frame F
3664 has been assigned the value NEW_VALUE. */
3667 update_face_from_frame_parameter (f
, param
, new_value
)
3669 Lisp_Object param
, new_value
;
3673 /* If there are no faces yet, give up. This is the case when called
3674 from Fx_create_frame, and we do the necessary things later in
3675 face-set-after-frame-defaults. */
3676 if (NILP (f
->face_alist
))
3679 if (EQ (param
, Qforeground_color
))
3681 lface
= lface_from_face_name (f
, Qdefault
, 1);
3682 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3683 ? new_value
: Qunspecified
);
3684 realize_basic_faces (f
);
3686 else if (EQ (param
, Qbackground_color
))
3690 /* Changing the background color might change the background
3691 mode, so that we have to load new defface specs. Call
3692 frame-update-face-colors to do that. */
3693 XSETFRAME (frame
, f
);
3694 call1 (Qframe_update_face_colors
, frame
);
3696 lface
= lface_from_face_name (f
, Qdefault
, 1);
3697 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3698 ? new_value
: Qunspecified
);
3699 realize_basic_faces (f
);
3701 if (EQ (param
, Qborder_color
))
3703 lface
= lface_from_face_name (f
, Qborder
, 1);
3704 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3705 ? new_value
: Qunspecified
);
3707 else if (EQ (param
, Qcursor_color
))
3709 lface
= lface_from_face_name (f
, Qcursor
, 1);
3710 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3711 ? new_value
: Qunspecified
);
3713 else if (EQ (param
, Qmouse_color
))
3715 lface
= lface_from_face_name (f
, Qmouse
, 1);
3716 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3717 ? new_value
: Qunspecified
);
3722 /* Get the value of X resource RESOURCE, class CLASS for the display
3723 of frame FRAME. This is here because ordinary `x-get-resource'
3724 doesn't take a frame argument. */
3726 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3727 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3728 (resource
, class, frame
)
3729 Lisp_Object resource
, class, frame
;
3732 CHECK_STRING (resource
, 0);
3733 CHECK_STRING (class, 1);
3734 CHECK_LIVE_FRAME (frame
, 2);
3736 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3737 resource
, class, Qnil
, Qnil
);
3743 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3744 If VALUE is "on" or "true", return t. If VALUE is "off" or
3745 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3746 error; if SIGNAL_P is zero, return 0. */
3749 face_boolean_x_resource_value (value
, signal_p
)
3753 Lisp_Object result
= make_number (0);
3755 xassert (STRINGP (value
));
3757 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3758 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3760 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3761 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3763 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3764 result
= Qunspecified
;
3766 signal_error ("Invalid face attribute value from X resource", value
);
3772 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3773 Finternal_set_lisp_face_attribute_from_resource
,
3774 Sinternal_set_lisp_face_attribute_from_resource
,
3776 (face
, attr
, value
, frame
)
3777 Lisp_Object face
, attr
, value
, frame
;
3779 CHECK_SYMBOL (face
, 0);
3780 CHECK_SYMBOL (attr
, 1);
3781 CHECK_STRING (value
, 2);
3783 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3784 value
= Qunspecified
;
3785 else if (EQ (attr
, QCheight
))
3787 value
= Fstring_to_number (value
, make_number (10));
3788 if (XINT (value
) <= 0)
3789 signal_error ("Invalid face height from X resource", value
);
3791 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3792 value
= face_boolean_x_resource_value (value
, 1);
3793 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3794 value
= intern (XSTRING (value
)->data
);
3795 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3796 value
= face_boolean_x_resource_value (value
, 1);
3797 else if (EQ (attr
, QCunderline
)
3798 || EQ (attr
, QCoverline
)
3799 || EQ (attr
, QCstrike_through
)
3800 || EQ (attr
, QCbox
))
3802 Lisp_Object boolean_value
;
3804 /* If the result of face_boolean_x_resource_value is t or nil,
3805 VALUE does NOT specify a color. */
3806 boolean_value
= face_boolean_x_resource_value (value
, 0);
3807 if (SYMBOLP (boolean_value
))
3808 value
= boolean_value
;
3811 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3816 /***********************************************************************
3818 ***********************************************************************/
3820 #ifdef USE_X_TOOLKIT
3822 /* Structure used to pass X resources to functions called via
3823 XtApplyToWidgets. */
3834 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3835 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3838 /* Set widget W's X resources from P which points to an x_resources
3839 structure. If W is a cascade button, apply resources to W's
3843 xm_apply_resources (w
, p
)
3848 struct x_resources
*res
= (struct x_resources
*) p
;
3850 XtSetValues (w
, res
->av
, res
->ac
);
3851 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3854 XtSetValues (submenu
, res
->av
, res
->ac
);
3855 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3860 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3861 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3864 1. Setting the XmNfontList resource leads to an infinite loop
3865 somewhere in LessTif. */
3868 xm_set_menu_resources_from_menu_face (f
, widget
)
3878 lface
= lface_from_face_name (f
, Qmenu
, 1);
3879 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3881 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3883 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3887 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3889 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3893 /* If any font-related attribute of `menu' is set, set the font. */
3895 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3896 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3897 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3898 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3899 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3901 #if 0 /* Setting the font leads to an infinite loop somewhere
3902 in LessTif during geometry computation. */
3904 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3905 fl
= XmFontListAppendEntry (NULL
, fe
);
3906 XtSetArg (av
[ac
], XmNfontList
, fl
);
3911 xassert (ac
<= sizeof av
/ sizeof *av
);
3915 struct x_resources res
;
3917 XtSetValues (widget
, av
, ac
);
3918 res
.av
= av
, res
.ac
= ac
;
3919 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3921 XmFontListFree (fl
);
3926 #endif /* USE_MOTIF */
3930 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3931 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3934 /* Set widget W's resources from P which points to an x_resources
3938 xl_apply_resources (widget
, p
)
3942 struct x_resources
*res
= (struct x_resources
*) p
;
3943 XtSetValues (widget
, res
->av
, res
->ac
);
3947 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3948 This is the Lucid version. */
3951 xl_set_menu_resources_from_menu_face (f
, widget
)
3960 lface
= lface_from_face_name (f
, Qmenu
, 1);
3961 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3963 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3965 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3969 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3971 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3976 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3977 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3978 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3979 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3980 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3982 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3988 struct x_resources res
;
3990 XtSetValues (widget
, av
, ac
);
3992 /* We must do children here in case we're handling a pop-up menu
3993 in which case WIDGET is a popup shell. XtApplyToWidgets
3994 is a function from lwlib. */
3995 res
.av
= av
, res
.ac
= ac
;
3996 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4000 #endif /* USE_LUCID */
4003 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4006 x_set_menu_resources_from_menu_face (f
, widget
)
4010 /* Realized faces may have been removed on frame F, e.g. because of
4011 face attribute changes. Recompute them, if necessary, since we
4012 will need the `menu' face. */
4013 if (f
->face_cache
->used
== 0)
4014 recompute_basic_faces (f
);
4017 xl_set_menu_resources_from_menu_face (f
, widget
);
4020 xm_set_menu_resources_from_menu_face (f
, widget
);
4024 #endif /* USE_X_TOOLKIT */
4026 #endif /* HAVE_X_WINDOWS */
4030 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4031 Sinternal_get_lisp_face_attribute
,
4033 "Return face attribute KEYWORD of face SYMBOL.\n\
4034 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4035 face attribute name, signal an error.\n\
4036 If the optional argument FRAME is given, report on face FACE in that\n\
4037 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4038 frames). If FRAME is omitted or nil, use the selected frame.")
4039 (symbol
, keyword
, frame
)
4040 Lisp_Object symbol
, keyword
, frame
;
4042 Lisp_Object lface
, value
= Qnil
;
4044 CHECK_SYMBOL (symbol
, 0);
4045 CHECK_SYMBOL (keyword
, 1);
4048 lface
= lface_from_face_name (NULL
, symbol
, 1);
4052 frame
= selected_frame
;
4053 CHECK_LIVE_FRAME (frame
, 2);
4054 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4057 if (EQ (keyword
, QCfamily
))
4058 value
= LFACE_FAMILY (lface
);
4059 else if (EQ (keyword
, QCheight
))
4060 value
= LFACE_HEIGHT (lface
);
4061 else if (EQ (keyword
, QCweight
))
4062 value
= LFACE_WEIGHT (lface
);
4063 else if (EQ (keyword
, QCslant
))
4064 value
= LFACE_SLANT (lface
);
4065 else if (EQ (keyword
, QCunderline
))
4066 value
= LFACE_UNDERLINE (lface
);
4067 else if (EQ (keyword
, QCoverline
))
4068 value
= LFACE_OVERLINE (lface
);
4069 else if (EQ (keyword
, QCstrike_through
))
4070 value
= LFACE_STRIKE_THROUGH (lface
);
4071 else if (EQ (keyword
, QCbox
))
4072 value
= LFACE_BOX (lface
);
4073 else if (EQ (keyword
, QCinverse_video
)
4074 || EQ (keyword
, QCreverse_video
))
4075 value
= LFACE_INVERSE (lface
);
4076 else if (EQ (keyword
, QCforeground
))
4077 value
= LFACE_FOREGROUND (lface
);
4078 else if (EQ (keyword
, QCbackground
))
4079 value
= LFACE_BACKGROUND (lface
);
4080 else if (EQ (keyword
, QCstipple
))
4081 value
= LFACE_STIPPLE (lface
);
4082 else if (EQ (keyword
, QCwidth
))
4083 value
= LFACE_SWIDTH (lface
);
4085 signal_error ("Invalid face attribute name", keyword
);
4091 DEFUN ("internal-lisp-face-attribute-values",
4092 Finternal_lisp_face_attribute_values
,
4093 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4094 "Return a list of valid discrete values for face attribute ATTR.\n\
4095 Value is nil if ATTR doesn't have a discrete set of valid values.")
4099 Lisp_Object result
= Qnil
;
4101 CHECK_SYMBOL (attr
, 0);
4103 if (EQ (attr
, QCweight
)
4104 || EQ (attr
, QCslant
)
4105 || EQ (attr
, QCwidth
))
4107 /* Extract permissible symbols from tables. */
4108 struct table_entry
*table
;
4111 if (EQ (attr
, QCweight
))
4112 table
= weight_table
, dim
= DIM (weight_table
);
4113 else if (EQ (attr
, QCslant
))
4114 table
= slant_table
, dim
= DIM (slant_table
);
4116 table
= swidth_table
, dim
= DIM (swidth_table
);
4118 for (i
= 0; i
< dim
; ++i
)
4120 Lisp_Object symbol
= *table
[i
].symbol
;
4121 Lisp_Object tail
= result
;
4124 && !EQ (XCAR (tail
), symbol
))
4128 result
= Fcons (symbol
, result
);
4131 else if (EQ (attr
, QCunderline
))
4132 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4133 else if (EQ (attr
, QCoverline
))
4134 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4135 else if (EQ (attr
, QCstrike_through
))
4136 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4137 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4138 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4144 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4145 Sinternal_merge_in_global_face
, 2, 2, 0,
4146 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4148 Lisp_Object face
, frame
;
4150 Lisp_Object global_lface
, local_lface
;
4151 CHECK_LIVE_FRAME (frame
, 1);
4152 global_lface
= lface_from_face_name (NULL
, face
, 1);
4153 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4154 if (NILP (local_lface
))
4155 local_lface
= Finternal_make_lisp_face (face
, frame
);
4156 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4157 XVECTOR (local_lface
)->contents
);
4162 /* The following function is implemented for compatibility with 20.2.
4163 The function is used in x-resolve-fonts when it is asked to
4164 return fonts with the same size as the font of a face. This is
4165 done in fontset.el. */
4167 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4168 "Return the font name of face FACE, or nil if it is unspecified.\n\
4169 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4170 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4171 The font default for a face is either nil, or a list\n\
4172 of the form (bold), (italic) or (bold italic).\n\
4173 If FRAME is omitted or nil, use the selected frame.")
4175 Lisp_Object face
, frame
;
4179 Lisp_Object result
= Qnil
;
4180 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4182 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4183 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4184 result
= Fcons (Qbold
, result
);
4186 if (!NILP (LFACE_SLANT (lface
))
4187 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4188 result
= Fcons (Qitalic
, result
);
4194 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4195 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4196 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4197 return build_string (face
->font_name
);
4202 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4203 all attributes are `equal'. Tries to be fast because this function
4204 is called quite often. */
4207 lface_equal_p (v1
, v2
)
4208 Lisp_Object
*v1
, *v2
;
4212 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4214 Lisp_Object a
= v1
[i
];
4215 Lisp_Object b
= v2
[i
];
4217 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4218 and the other is specified. */
4219 equal_p
= XTYPE (a
) == XTYPE (b
);
4228 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4229 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4230 XSTRING (a
)->size
) == 0);
4239 equal_p
= !NILP (Fequal (a
, b
));
4249 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4250 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4251 "True if FACE1 and FACE2 are equal.\n\
4252 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4253 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4254 If FRAME is omitted or nil, use the selected frame.")
4255 (face1
, face2
, frame
)
4256 Lisp_Object face1
, face2
, frame
;
4260 Lisp_Object lface1
, lface2
;
4265 /* Don't use check_x_frame here because this function is called
4266 before X frames exist. At that time, if FRAME is nil,
4267 selected_frame will be used which is the frame dumped with
4268 Emacs. That frame is not an X frame. */
4269 f
= frame_or_selected_frame (frame
, 2);
4271 lface1
= lface_from_face_name (NULL
, face1
, 1);
4272 lface2
= lface_from_face_name (NULL
, face2
, 1);
4273 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4274 XVECTOR (lface2
)->contents
);
4275 return equal_p
? Qt
: Qnil
;
4279 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4280 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4281 "True if FACE has no attribute specified.\n\
4282 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4283 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4284 If FRAME is omitted or nil, use the selected frame.")
4286 Lisp_Object face
, frame
;
4293 frame
= selected_frame
;
4294 CHECK_LIVE_FRAME (frame
, 0);
4298 lface
= lface_from_face_name (NULL
, face
, 1);
4300 lface
= lface_from_face_name (f
, face
, 1);
4302 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4303 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4306 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4310 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4312 "Return an alist of frame-local faces defined on FRAME.\n\
4313 For internal use only.")
4317 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4318 return f
->face_alist
;
4322 /* Return a hash code for Lisp string STRING with case ignored. Used
4323 below in computing a hash value for a Lisp face. */
4325 static INLINE
unsigned
4326 hash_string_case_insensitive (string
)
4331 xassert (STRINGP (string
));
4332 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4333 hash
= (hash
<< 1) ^ tolower (*s
);
4338 /* Return a hash code for face attribute vector V. */
4340 static INLINE
unsigned
4344 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4345 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4346 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4347 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4348 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4349 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4350 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4354 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4355 considering charsets/registries). They do if they specify the same
4356 family, point size, weight, width and slant. Both LFACE1 and
4357 LFACE2 must be fully-specified. */
4360 lface_same_font_attributes_p (lface1
, lface2
)
4361 Lisp_Object
*lface1
, *lface2
;
4363 xassert (lface_fully_specified_p (lface1
)
4364 && lface_fully_specified_p (lface2
));
4365 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4366 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4367 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4368 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4369 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4370 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4371 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4376 /***********************************************************************
4378 ***********************************************************************/
4380 /* Allocate and return a new realized face for Lisp face attribute
4381 vector ATTR, charset CHARSET, and registry REGISTRY. */
4383 static struct face
*
4384 make_realized_face (attr
, charset
, registry
)
4387 Lisp_Object registry
;
4389 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4390 bzero (face
, sizeof *face
);
4391 face
->charset
= charset
;
4392 face
->registry
= registry
;
4393 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4398 /* Free realized face FACE, including its X resources. FACE may
4402 free_realized_face (f
, face
)
4408 #ifdef HAVE_X_WINDOWS
4413 x_free_gc (f
, face
->gc
);
4417 free_face_colors (f
, face
);
4418 x_destroy_bitmap (f
, face
->stipple
);
4420 #endif /* HAVE_X_WINDOWS */
4427 /* Prepare face FACE for subsequent display on frame F. This
4428 allocated GCs if they haven't been allocated yet or have been freed
4429 by clearing the face cache. */
4432 prepare_face_for_display (f
, face
)
4436 #ifdef HAVE_X_WINDOWS
4437 xassert (FRAME_X_P (f
));
4442 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4444 xgcv
.foreground
= face
->foreground
;
4445 xgcv
.background
= face
->background
;
4446 xgcv
.graphics_exposures
= False
;
4448 /* The font of FACE may be null if we couldn't load it. */
4451 xgcv
.font
= face
->font
->fid
;
4458 xgcv
.fill_style
= FillOpaqueStippled
;
4459 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4460 mask
|= GCFillStyle
| GCStipple
;
4463 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4470 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4471 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4472 ISO8859-1 if the ASCII face suffices. */
4475 face_suitable_for_iso8859_1_p (face
)
4478 int len
= strlen (face
->font_name
);
4479 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4483 /* Value is non-zero if FACE is suitable for displaying characters
4484 of CHARSET. CHARSET < 0 means unibyte text. */
4487 face_suitable_for_charset_p (face
, charset
)
4495 if (EQ (face
->registry
, Vface_default_registry
)
4496 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4499 else if (face
->charset
== charset
)
4501 else if (face
->charset
== CHARSET_ASCII
4502 && charset
== charset_latin_iso8859_1
)
4503 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4504 else if (face
->charset
== charset_latin_iso8859_1
4505 && charset
== CHARSET_ASCII
)
4513 /***********************************************************************
4515 ***********************************************************************/
4517 /* Return a new face cache for frame F. */
4519 static struct face_cache
*
4523 struct face_cache
*c
;
4526 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4527 bzero (c
, sizeof *c
);
4528 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4529 c
->buckets
= (struct face
**) xmalloc (size
);
4530 bzero (c
->buckets
, size
);
4532 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4538 /* Clear out all graphics contexts for all realized faces, except for
4539 the basic faces. This should be done from time to time just to avoid
4540 keeping too many graphics contexts that are no longer needed. */
4544 struct face_cache
*c
;
4546 if (c
&& FRAME_X_P (c
->f
))
4548 #ifdef HAVE_X_WINDOWS
4550 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4552 struct face
*face
= c
->faces_by_id
[i
];
4553 if (face
&& face
->gc
)
4555 x_free_gc (c
->f
, face
->gc
);
4559 #endif /* HAVE_X_WINDOWS */
4564 /* Free all realized faces in face cache C, including basic faces. C
4565 may be null. If faces are freed, make sure the frame's current
4566 matrix is marked invalid, so that a display caused by an expose
4567 event doesn't try to use faces we destroyed. */
4570 free_realized_faces (c
)
4571 struct face_cache
*c
;
4576 struct frame
*f
= c
->f
;
4578 for (i
= 0; i
< c
->used
; ++i
)
4580 free_realized_face (f
, c
->faces_by_id
[i
]);
4581 c
->faces_by_id
[i
] = NULL
;
4585 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4586 bzero (c
->buckets
, size
);
4588 /* Must do a thorough redisplay the next time. Mark current
4589 matrices as invalid because they will reference faces freed
4590 above. This function is also called when a frame is
4591 destroyed. In this case, the root window of F is nil. */
4592 if (WINDOWP (f
->root_window
))
4594 clear_current_matrices (f
);
4595 ++windows_or_buffers_changed
;
4601 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4602 This is done after attributes of a named face have been changed,
4603 because we can't tell which realized faces depend on that face. */
4606 free_all_realized_faces (frame
)
4612 FOR_EACH_FRAME (rest
, frame
)
4613 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4616 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4620 /* Free face cache C and faces in it, including their X resources. */
4624 struct face_cache
*c
;
4628 free_realized_faces (c
);
4630 xfree (c
->faces_by_id
);
4636 /* Cache realized face FACE in face cache C. HASH is the hash value
4637 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4638 collision list of the face hash table of C. This is done because
4639 otherwise lookup_face would find FACE for every charset, even if
4640 faces with the same attributes but for specific charsets exist. */
4643 cache_face (c
, face
, hash
)
4644 struct face_cache
*c
;
4648 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4652 if (face
->fontset
>= 0)
4654 struct face
*last
= c
->buckets
[i
];
4665 c
->buckets
[i
] = face
;
4666 face
->prev
= face
->next
= NULL
;
4672 face
->next
= c
->buckets
[i
];
4674 face
->next
->prev
= face
;
4675 c
->buckets
[i
] = face
;
4678 /* Find a free slot in C->faces_by_id and use the index of the free
4679 slot as FACE->id. */
4680 for (i
= 0; i
< c
->used
; ++i
)
4681 if (c
->faces_by_id
[i
] == NULL
)
4685 /* Maybe enlarge C->faces_by_id. */
4686 if (i
== c
->used
&& c
->used
== c
->size
)
4688 int new_size
= 2 * c
->size
;
4689 int sz
= new_size
* sizeof *c
->faces_by_id
;
4690 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4695 /* Check that FACE got a unique id. */
4700 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4701 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4707 #endif /* GLYPH_DEBUG */
4709 c
->faces_by_id
[i
] = face
;
4715 /* Remove face FACE from cache C. */
4718 uncache_face (c
, face
)
4719 struct face_cache
*c
;
4722 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4725 face
->prev
->next
= face
->next
;
4727 c
->buckets
[i
] = face
->next
;
4730 face
->next
->prev
= face
->prev
;
4732 c
->faces_by_id
[face
->id
] = NULL
;
4733 if (face
->id
== c
->used
)
4738 /* Look up a realized face with face attributes ATTR in the face cache
4739 of frame F. The face will be used to display characters of
4740 CHARSET. CHARSET < 0 means the face will be used to display
4741 unibyte text. The value of face-default-registry is used to choose
4742 a font for the face in that case. Value is the ID of the face
4743 found. If no suitable face is found, realize a new one. */
4746 lookup_face (f
, attr
, charset
)
4751 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4756 xassert (c
!= NULL
);
4757 check_lface_attrs (attr
);
4759 /* Look up ATTR in the face cache. */
4760 hash
= lface_hash (attr
);
4761 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4763 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4764 if (face
->hash
== hash
4765 && (!FRAME_WINDOW_P (f
)
4766 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4767 && lface_equal_p (face
->lface
, attr
))
4770 /* If not found, realize a new face. */
4773 face
= realize_face (c
, attr
, charset
);
4774 cache_face (c
, face
, hash
);
4778 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4780 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4781 #endif /* GLYPH_DEBUG */
4787 /* Return the face id of the realized face for named face SYMBOL on
4788 frame F suitable for displaying characters from CHARSET. CHARSET <
4789 0 means unibyte text. */
4792 lookup_named_face (f
, symbol
, charset
)
4797 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4798 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4799 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4801 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4802 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4803 merge_face_vectors (symbol_attrs
, attrs
);
4804 return lookup_face (f
, attrs
, charset
);
4808 /* Return the ID of the realized ASCII face of Lisp face with ID
4809 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4812 ascii_face_of_lisp_face (f
, lface_id
)
4818 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4820 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4821 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4830 /* Return a face for charset ASCII that is like the face with id
4831 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4832 STEPS < 0 means larger. Value is the id of the face. */
4835 smaller_face (f
, face_id
, steps
)
4839 #ifdef HAVE_X_WINDOWS
4841 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4842 int pt
, last_pt
, last_height
;
4845 struct face
*new_face
;
4847 /* If not called for an X frame, just return the original face. */
4848 if (FRAME_TERMCAP_P (f
))
4851 /* Try in increments of 1/2 pt. */
4852 delta
= steps
< 0 ? 5 : -5;
4853 steps
= abs (steps
);
4855 face
= FACE_FROM_ID (f
, face_id
);
4856 bcopy (face
->lface
, attrs
, sizeof attrs
);
4857 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4858 new_face_id
= face_id
;
4859 last_height
= FONT_HEIGHT (face
->font
);
4863 /* Give up if we cannot find a font within 10pt. */
4864 && abs (last_pt
- pt
) < 100)
4866 /* Look up a face for a slightly smaller/larger font. */
4868 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4869 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4870 new_face
= FACE_FROM_ID (f
, new_face_id
);
4872 /* If height changes, count that as one step. */
4873 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4876 last_height
= FONT_HEIGHT (new_face
->font
);
4883 #else /* not HAVE_X_WINDOWS */
4887 #endif /* not HAVE_X_WINDOWS */
4891 /* Return a face for charset ASCII that is like the face with id
4892 FACE_ID on frame F, but has height HEIGHT. */
4895 face_with_height (f
, face_id
, height
)
4900 #ifdef HAVE_X_WINDOWS
4902 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4904 if (FRAME_TERMCAP_P (f
)
4908 face
= FACE_FROM_ID (f
, face_id
);
4909 bcopy (face
->lface
, attrs
, sizeof attrs
);
4910 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4911 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4912 #endif /* HAVE_X_WINDOWS */
4917 /* Return the face id of the realized face for named face SYMBOL on
4918 frame F suitable for displaying characters from CHARSET (CHARSET <
4919 0 means unibyte text), and use attributes of the face FACE_ID for
4920 attributes that aren't completely specified by SYMBOL. This is
4921 like lookup_named_face, except that the default attributes come
4922 from FACE_ID, not from the default face. FACE_ID is assumed to
4923 be already realized. */
4926 lookup_derived_face (f
, symbol
, charset
, face_id
)
4932 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4933 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4934 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4939 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4940 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4941 merge_face_vectors (symbol_attrs
, attrs
);
4942 return lookup_face (f
, attrs
, charset
);
4947 /***********************************************************************
4949 ***********************************************************************/
4951 DEFUN ("internal-set-font-selection-order",
4952 Finternal_set_font_selection_order
,
4953 Sinternal_set_font_selection_order
, 1, 1, 0,
4954 "Set font selection order for face font selection to ORDER.\n\
4955 ORDER must be a list of length 4 containing the symbols `:width',\n\
4956 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4957 first in ORDER are matched first, e.g. if `:height' appears before\n\
4958 `:weight' in ORDER, font selection first tries to find a font with\n\
4959 a suitable height, and then tries to match the font weight.\n\
4968 CHECK_LIST (order
, 0);
4969 bzero (indices
, sizeof indices
);
4973 CONSP (list
) && i
< DIM (indices
);
4974 list
= XCDR (list
), ++i
)
4976 Lisp_Object attr
= XCAR (list
);
4979 if (EQ (attr
, QCwidth
))
4981 else if (EQ (attr
, QCheight
))
4982 xlfd
= XLFD_POINT_SIZE
;
4983 else if (EQ (attr
, QCweight
))
4985 else if (EQ (attr
, QCslant
))
4990 if (indices
[i
] != 0)
4996 || i
!= DIM (indices
)
5001 signal_error ("Invalid font sort order", order
);
5003 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5005 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5006 free_all_realized_faces (Qnil
);
5013 DEFUN ("internal-set-alternative-font-family-alist",
5014 Finternal_set_alternative_font_family_alist
,
5015 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5016 "Define alternative font families to try in face font selection.\n\
5017 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5018 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5019 be found. Value is ALIST.")
5023 CHECK_LIST (alist
, 0);
5024 Vface_alternative_font_family_alist
= alist
;
5025 free_all_realized_faces (Qnil
);
5030 #ifdef HAVE_X_WINDOWS
5032 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5033 Value is nil if not successful. */
5036 deduce_unibyte_registry (f
, font_name
)
5040 struct font_name font
;
5041 Lisp_Object registry
= Qnil
;
5043 font
.name
= STRDUPA (font_name
);
5044 if (split_font_name (f
, &font
, 0))
5048 /* Extract registry and encoding. */
5049 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5050 + strlen (font
.fields
[XLFD_ENCODING
])
5052 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5053 strcat (buffer
, "-");
5054 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5055 registry
= build_string (buffer
);
5062 /* Value is non-zero if FONT is the name of a scalable font. The
5063 X11R6 XLFD spec says that point size, pixel size, and average width
5064 are zero for scalable fonts. Intlfonts contain at least one
5065 scalable font ("*-muleindian-1") for which this isn't true, so we
5066 just test average width. */
5069 font_scalable_p (font
)
5070 struct font_name
*font
;
5072 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5073 return *s
== '0' && *(s
+ 1) == '\0';
5077 /* Value is non-zero if FONT1 is a better match for font attributes
5078 VALUES than FONT2. VALUES is an array of face attribute values in
5079 font sort order. COMPARE_PT_P zero means don't compare point
5083 better_font_p (values
, font1
, font2
, compare_pt_p
)
5085 struct font_name
*font1
, *font2
;
5090 for (i
= 0; i
< 4; ++i
)
5092 int xlfd_idx
= font_sort_order
[i
];
5094 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5096 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5097 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5099 if (delta1
> delta2
)
5101 else if (delta1
< delta2
)
5105 /* The difference may be equal because, e.g., the face
5106 specifies `italic' but we have only `regular' and
5107 `oblique'. Prefer `oblique' in this case. */
5108 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5109 && font1
->numeric
[xlfd_idx
] > values
[i
]
5110 && font2
->numeric
[xlfd_idx
] < values
[i
])
5122 /* Value is non-zero if FONT is an exact match for face attributes in
5123 SPECIFIED. SPECIFIED is an array of face attribute values in font
5127 exact_face_match_p (specified
, font
)
5129 struct font_name
*font
;
5133 for (i
= 0; i
< 4; ++i
)
5134 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5141 /* Value is the name of a scaled font, generated from scalable font
5142 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5143 Value is allocated from heap. */
5146 build_scalable_font_name (f
, font
, specified_pt
)
5148 struct font_name
*font
;
5151 char point_size
[20], pixel_size
[20];
5153 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5156 /* If scalable font is for a specific resolution, compute
5157 the point size we must specify from the resolution of
5158 the display and the specified resolution of the font. */
5159 if (font
->numeric
[XLFD_RESY
] != 0)
5161 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5162 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5167 pixel_value
= resy
/ 720.0 * pt
;
5170 /* Set point size of the font. */
5171 sprintf (point_size
, "%d", (int) pt
);
5172 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5173 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5175 /* Set pixel size. */
5176 sprintf (pixel_size
, "%d", pixel_value
);
5177 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5178 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5180 /* If font doesn't specify its resolution, use the
5181 resolution of the display. */
5182 if (font
->numeric
[XLFD_RESY
] == 0)
5185 sprintf (buffer
, "%d", (int) resy
);
5186 font
->fields
[XLFD_RESY
] = buffer
;
5187 font
->numeric
[XLFD_RESY
] = resy
;
5190 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5193 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5194 sprintf (buffer
, "%d", resx
);
5195 font
->fields
[XLFD_RESX
] = buffer
;
5196 font
->numeric
[XLFD_RESX
] = resx
;
5199 return build_font_name (font
);
5203 /* Value is non-zero if we are allowed to use scalable font FONT. We
5204 can't run a Lisp function here since this function may be called
5205 with input blocked. */
5208 may_use_scalable_font_p (font
, name
)
5209 struct font_name
*font
;
5212 if (EQ (Vscalable_fonts_allowed
, Qt
))
5214 else if (CONSP (Vscalable_fonts_allowed
))
5216 Lisp_Object tail
, regexp
;
5218 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5220 regexp
= XCAR (tail
);
5221 if (STRINGP (regexp
)
5222 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5230 #endif /* SCALABLE_FONTS != 0 */
5233 /* Return the name of the best matching font for face attributes
5234 ATTRS in the array of font_name structures FONTS which contains
5235 NFONTS elements. Value is a font name which is allocated from
5236 the heap. FONTS is freed by this function. */
5239 best_matching_font (f
, attrs
, fonts
, nfonts
)
5242 struct font_name
*fonts
;
5246 struct font_name
*best
;
5254 /* Make specified font attributes available in `specified',
5255 indexed by sort order. */
5256 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5258 int xlfd_idx
= font_sort_order
[i
];
5260 if (xlfd_idx
== XLFD_SWIDTH
)
5261 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5262 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5263 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5264 else if (xlfd_idx
== XLFD_WEIGHT
)
5265 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5266 else if (xlfd_idx
== XLFD_SLANT
)
5267 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5277 /* Start with the first non-scalable font in the list. */
5278 for (i
= 0; i
< nfonts
; ++i
)
5279 if (!font_scalable_p (fonts
+ i
))
5282 /* Find the best match among the non-scalable fonts. */
5287 for (i
= 1; i
< nfonts
; ++i
)
5288 if (!font_scalable_p (fonts
+ i
)
5289 && better_font_p (specified
, fonts
+ i
, best
, 1))
5293 exact_p
= exact_face_match_p (specified
, best
);
5302 /* Unless we found an exact match among non-scalable fonts, see if
5303 we can find a better match among scalable fonts. */
5306 /* A scalable font is better if
5308 1. its weight, slant, swidth attributes are better, or.
5310 2. the best non-scalable font doesn't have the required
5311 point size, and the scalable fonts weight, slant, swidth
5314 int non_scalable_has_exact_height_p
;
5316 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5317 non_scalable_has_exact_height_p
= 1;
5319 non_scalable_has_exact_height_p
= 0;
5321 for (i
= 0; i
< nfonts
; ++i
)
5322 if (font_scalable_p (fonts
+ i
))
5325 || better_font_p (specified
, fonts
+ i
, best
, 0)
5326 || (!non_scalable_has_exact_height_p
5327 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5332 if (font_scalable_p (best
))
5333 font_name
= build_scalable_font_name (f
, best
, pt
);
5335 font_name
= build_font_name (best
);
5337 #else /* !SCALABLE_FONTS */
5339 /* Find the best non-scalable font. */
5342 for (i
= 1; i
< nfonts
; ++i
)
5344 xassert (!font_scalable_p (fonts
+ i
));
5345 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5349 font_name
= build_font_name (best
);
5351 #endif /* !SCALABLE_FONTS */
5353 /* Free font_name structures. */
5354 free_font_names (fonts
, nfonts
);
5360 /* Try to get a list of fonts on frame F with font family FAMILY and
5361 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5362 of font_name structures for the fonts matched. Value is the number
5366 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5369 char *pattern
, *family
, *registry
;
5370 struct font_name
**fonts
;
5375 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5377 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5383 /* Try alternative font families from
5384 Vface_alternative_font_family_alist. */
5385 alter
= Fassoc (build_string (family
),
5386 Vface_alternative_font_family_alist
);
5388 for (alter
= XCDR (alter
);
5389 CONSP (alter
) && nfonts
== 0;
5390 alter
= XCDR (alter
))
5392 if (STRINGP (XCAR (alter
)))
5394 family
= LSTRDUPA (XCAR (alter
));
5395 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5399 /* Try font family of the default face or "fixed". */
5402 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5404 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5407 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5410 /* Try any family with the given registry. */
5412 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5419 /* Return the registry and encoding pattern that fonts for CHARSET
5420 should match. Value is allocated from the heap. */
5423 x_charset_registry (charset
)
5426 Lisp_Object prop
, charset_plist
;
5429 /* Get registry and encoding from the charset's plist. */
5430 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5431 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5435 if (index (XSTRING (prop
)->data
, '-'))
5436 registry
= xstrdup (XSTRING (prop
)->data
);
5439 /* If registry doesn't contain a `-', make it a pattern. */
5440 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5441 strcpy (registry
, XSTRING (prop
)->data
);
5442 strcat (registry
, "*-*");
5445 else if (STRINGP (Vface_default_registry
))
5446 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5448 registry
= xstrdup ("iso8859-1");
5454 /* Return the fontset id of the fontset name or alias name given by
5455 the family attribute of ATTRS on frame F. Value is -1 if the
5456 family attribute of ATTRS doesn't name a fontset. */
5459 face_fontset (f
, attrs
)
5463 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5466 name
= Fquery_fontset (name
, Qnil
);
5470 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5476 /* Get the font to use for the face realizing the fully-specified Lisp
5477 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5478 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5479 in this case. Value is the font name which is allocated from the
5480 heap (which means that it must be freed eventually). */
5483 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5487 Lisp_Object unibyte_registry
;
5489 struct font_name
*fonts
;
5493 /* ATTRS must be fully-specified. */
5494 xassert (lface_fully_specified_p (attrs
));
5496 if (STRINGP (unibyte_registry
))
5497 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5499 registry
= x_charset_registry (charset
);
5501 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5503 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5507 /* Choose a font to use on frame F to display CHARSET using FONTSET
5508 with Lisp face attributes specified by ATTRS. CHARSET may be any
5509 valid charset. CHARSET < 0 means unibyte text. If the fontset
5510 doesn't contain a font pattern for charset, use the pattern for
5511 CHARSET_ASCII. Value is the font name which is allocated from the
5512 heap and must be freed by the caller. */
5515 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5518 int fontset
, charset
;
5521 char *font_name
= NULL
;
5522 struct fontset_info
*fontset_info
;
5523 struct font_name
*fonts
;
5526 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5528 /* For unibyte text, use the ASCII font of the fontset. Using the
5529 ASCII font seems to be the most reasonable thing we can do in
5532 charset
= CHARSET_ASCII
;
5534 /* Get the font name pattern to use for CHARSET from the fontset. */
5535 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5536 pattern
= fontset_info
->fontname
[charset
];
5538 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5541 /* Get a list of fonts matching that pattern and choose the
5542 best match for the specified face attributes from it. */
5543 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5544 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5548 #endif /* HAVE_X_WINDOWS */
5552 /***********************************************************************
5554 ***********************************************************************/
5556 /* Realize basic faces on frame F. Value is zero if frame parameters
5557 of F don't contain enough information needed to realize the default
5561 realize_basic_faces (f
)
5566 if (realize_default_face (f
))
5568 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5569 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5570 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5571 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5572 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5573 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5574 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5575 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5576 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5584 /* Realize the default face on frame F. If the face is not fully
5585 specified, make it fully-specified. Attributes of the default face
5586 that are not explicitly specified are taken from frame parameters. */
5589 realize_default_face (f
)
5592 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5594 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5595 Lisp_Object unibyte_registry
;
5596 Lisp_Object frame_font
;
5600 /* If the `default' face is not yet known, create it. */
5601 lface
= lface_from_face_name (f
, Qdefault
, 0);
5605 XSETFRAME (frame
, f
);
5606 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5609 #ifdef HAVE_X_WINDOWS
5612 /* Set frame_font to the value of the `font' frame parameter. */
5613 frame_font
= Fassq (Qfont
, f
->param_alist
);
5614 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5615 frame_font
= XCDR (frame_font
);
5617 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5620 /* If frame_font is a fontset name, don't use that for
5621 determining font-related attributes of the default face
5622 because it is just an artificial name. Use the ASCII font of
5623 the fontset, instead. */
5624 struct font_info
*font_info
;
5625 struct font_name font
;
5628 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5632 /* Set weight etc. from the ASCII font. */
5633 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5636 /* Remember registry and encoding of the frame font. */
5637 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5638 if (STRINGP (unibyte_registry
))
5639 Vface_default_registry
= unibyte_registry
;
5641 Vface_default_registry
= build_string ("iso8859-1");
5643 /* But set the family to the fontset alias name. Implementation
5644 note: When a font is passed to Emacs via `-fn FONT', a
5645 fontset is created in `x-win.el' whose name ends in
5646 `fontset-startup'. This fontset has an alias name that is
5647 equal to frame_font. */
5648 xassert (STRINGP (frame_font
));
5649 font
.name
= LSTRDUPA (frame_font
);
5651 if (!split_font_name (f
, &font
, 1)
5652 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5653 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5654 LFACE_FAMILY (lface
) = frame_font
;
5658 /* Frame parameters contain a real font. Fill default face
5659 attributes from that font. */
5660 if (!set_lface_from_font_name (f
, lface
,
5661 XSTRING (frame_font
)->data
, 0, 0))
5664 /* Remember registry and encoding of the frame font. */
5666 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5667 if (STRINGP (unibyte_registry
))
5668 Vface_default_registry
= unibyte_registry
;
5670 Vface_default_registry
= build_string ("iso8859-1");
5673 #endif /* HAVE_X_WINDOWS */
5675 if (!FRAME_WINDOW_P (f
))
5677 LFACE_FAMILY (lface
) = build_string ("default");
5678 LFACE_SWIDTH (lface
) = Qnormal
;
5679 LFACE_HEIGHT (lface
) = make_number (1);
5680 LFACE_WEIGHT (lface
) = Qnormal
;
5681 LFACE_SLANT (lface
) = Qnormal
;
5684 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5685 LFACE_UNDERLINE (lface
) = Qnil
;
5687 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5688 LFACE_OVERLINE (lface
) = Qnil
;
5690 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5691 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5693 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5694 LFACE_BOX (lface
) = Qnil
;
5696 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5697 LFACE_INVERSE (lface
) = Qnil
;
5699 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5701 /* This function is called so early that colors are not yet
5702 set in the frame parameter list. */
5703 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5705 if (CONSP (color
) && STRINGP (XCDR (color
)))
5706 LFACE_FOREGROUND (lface
) = XCDR (color
);
5707 else if (FRAME_X_P (f
))
5709 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5710 LFACE_FOREGROUND (lface
) = Qunspecified_fg
;
5715 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5717 /* This function is called so early that colors are not yet
5718 set in the frame parameter list. */
5719 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5720 if (CONSP (color
) && STRINGP (XCDR (color
)))
5721 LFACE_BACKGROUND (lface
) = XCDR (color
);
5722 else if (FRAME_X_P (f
))
5724 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5725 LFACE_BACKGROUND (lface
) = Qunspecified_bg
;
5730 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5731 LFACE_STIPPLE (lface
) = Qnil
;
5733 /* Realize the face; it must be fully-specified now. */
5734 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5735 check_lface (lface
);
5736 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5737 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5739 /* Remove the former default face. */
5740 if (c
->used
> DEFAULT_FACE_ID
)
5742 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5743 uncache_face (c
, default_face
);
5744 free_realized_face (f
, default_face
);
5747 /* Insert the new default face. */
5748 cache_face (c
, face
, lface_hash (attrs
));
5749 xassert (face
->id
== DEFAULT_FACE_ID
);
5754 /* Realize basic faces other than the default face in face cache C.
5755 SYMBOL is the face name, ID is the face id the realized face must
5756 have. The default face must have been realized already. */
5759 realize_named_face (f
, symbol
, id
)
5764 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5765 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5766 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5767 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5768 struct face
*new_face
;
5770 /* The default face must exist and be fully specified. */
5771 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5772 check_lface_attrs (attrs
);
5773 xassert (lface_fully_specified_p (attrs
));
5775 /* If SYMBOL isn't know as a face, create it. */
5779 XSETFRAME (frame
, f
);
5780 lface
= Finternal_make_lisp_face (symbol
, frame
);
5783 /* Merge SYMBOL's face with the default face. */
5784 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5785 merge_face_vectors (symbol_attrs
, attrs
);
5787 /* Realize the face. */
5788 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5790 /* Remove the former face. */
5793 struct face
*old_face
= c
->faces_by_id
[id
];
5794 uncache_face (c
, old_face
);
5795 free_realized_face (f
, old_face
);
5798 /* Insert the new face. */
5799 cache_face (c
, new_face
, lface_hash (attrs
));
5800 xassert (new_face
->id
== id
);
5804 /* Realize the fully-specified face with attributes ATTRS in face
5805 cache C for character set CHARSET or for unibyte text if CHARSET <
5806 0. Value is a pointer to the newly created realized face. */
5808 static struct face
*
5809 realize_face (c
, attrs
, charset
)
5810 struct face_cache
*c
;
5816 /* LFACE must be fully specified. */
5817 xassert (c
!= NULL
);
5818 check_lface_attrs (attrs
);
5820 if (FRAME_X_P (c
->f
))
5821 face
= realize_x_face (c
, attrs
, charset
);
5822 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5823 face
= realize_tty_face (c
, attrs
, charset
);
5831 /* Realize the fully-specified face with attributes ATTRS in face
5832 cache C for character set CHARSET or for unibyte text if CHARSET <
5833 0. Do it for X frame C->f. Value is a pointer to the newly
5834 created realized face. */
5836 static struct face
*
5837 realize_x_face (c
, attrs
, charset
)
5838 struct face_cache
*c
;
5842 #ifdef HAVE_X_WINDOWS
5843 struct face
*face
, *default_face
;
5845 Lisp_Object stipple
, overline
, strike_through
, box
;
5846 Lisp_Object unibyte_registry
;
5847 struct gcpro gcpro1
;
5849 xassert (FRAME_X_P (c
->f
));
5851 /* If realizing a face for use in unibyte text, get the X registry
5852 and encoding to use from Vface_default_registry. */
5854 unibyte_registry
= (STRINGP (Vface_default_registry
)
5855 ? Vface_default_registry
5856 : build_string ("iso8859-1"));
5858 unibyte_registry
= Qnil
;
5859 GCPRO1 (unibyte_registry
);
5861 /* Allocate a new realized face. */
5862 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5865 /* Determine the font to use. Most of the time, the font will be
5866 the same as the font of the default face, so try that first. */
5867 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5869 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5870 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5872 face
->font
= default_face
->font
;
5873 face
->fontset
= default_face
->fontset
;
5874 face
->font_info_id
= default_face
->font_info_id
;
5875 face
->font_name
= default_face
->font_name
;
5876 face
->registry
= default_face
->registry
;
5878 else if (charset
>= 0)
5880 /* For all charsets, we use our own font selection functions to
5881 choose a best matching font for the specified face
5882 attributes. If the face specifies a fontset alias name, the
5883 fontset determines the font name pattern, otherwise we
5884 construct a font pattern from face attributes and charset. */
5886 char *font_name
= NULL
;
5887 int fontset
= face_fontset (f
, attrs
);
5890 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5893 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5897 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5902 /* Unibyte case, and font is not equal to that of the default
5903 face. UNIBYTE_REGISTRY is the X registry and encoding the
5904 font should have. What is a reasonable thing to do if the
5905 user specified a fontset alias name for the face in this
5906 case? We choose a font by taking the ASCII font of the
5907 fontset, but using UNIBYTE_REGISTRY for its registry and
5910 char *font_name
= NULL
;
5911 int fontset
= face_fontset (f
, attrs
);
5914 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5916 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5918 load_face_font_or_fontset (f
, face
, font_name
, -1);
5922 /* Load colors, and set remaining attributes. */
5924 load_face_colors (f
, face
, attrs
);
5927 box
= attrs
[LFACE_BOX_INDEX
];
5930 /* A simple box of line width 1 drawn in color given by
5932 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5934 face
->box
= FACE_SIMPLE_BOX
;
5935 face
->box_line_width
= 1;
5937 else if (INTEGERP (box
))
5939 /* Simple box of specified line width in foreground color of the
5941 xassert (XINT (box
) > 0);
5942 face
->box
= FACE_SIMPLE_BOX
;
5943 face
->box_line_width
= XFASTINT (box
);
5944 face
->box_color
= face
->foreground
;
5945 face
->box_color_defaulted_p
= 1;
5947 else if (CONSP (box
))
5949 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5950 being one of `raised' or `sunken'. */
5951 face
->box
= FACE_SIMPLE_BOX
;
5952 face
->box_color
= face
->foreground
;
5953 face
->box_color_defaulted_p
= 1;
5954 face
->box_line_width
= 1;
5958 Lisp_Object keyword
, value
;
5960 keyword
= XCAR (box
);
5968 if (EQ (keyword
, QCline_width
))
5970 if (INTEGERP (value
) && XINT (value
) > 0)
5971 face
->box_line_width
= XFASTINT (value
);
5973 else if (EQ (keyword
, QCcolor
))
5975 if (STRINGP (value
))
5977 face
->box_color
= load_color (f
, face
, value
,
5979 face
->use_box_color_for_shadows_p
= 1;
5982 else if (EQ (keyword
, QCstyle
))
5984 if (EQ (value
, Qreleased_button
))
5985 face
->box
= FACE_RAISED_BOX
;
5986 else if (EQ (value
, Qpressed_button
))
5987 face
->box
= FACE_SUNKEN_BOX
;
5992 /* Text underline, overline, strike-through. */
5994 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5996 /* Use default color (same as foreground color). */
5997 face
->underline_p
= 1;
5998 face
->underline_defaulted_p
= 1;
5999 face
->underline_color
= 0;
6001 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6003 /* Use specified color. */
6004 face
->underline_p
= 1;
6005 face
->underline_defaulted_p
= 0;
6006 face
->underline_color
6007 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6008 LFACE_UNDERLINE_INDEX
);
6010 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6012 face
->underline_p
= 0;
6013 face
->underline_defaulted_p
= 0;
6014 face
->underline_color
= 0;
6017 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6018 if (STRINGP (overline
))
6020 face
->overline_color
6021 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6022 LFACE_OVERLINE_INDEX
);
6023 face
->overline_p
= 1;
6025 else if (EQ (overline
, Qt
))
6027 face
->overline_color
= face
->foreground
;
6028 face
->overline_color_defaulted_p
= 1;
6029 face
->overline_p
= 1;
6032 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6033 if (STRINGP (strike_through
))
6035 face
->strike_through_color
6036 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6037 LFACE_STRIKE_THROUGH_INDEX
);
6038 face
->strike_through_p
= 1;
6040 else if (EQ (strike_through
, Qt
))
6042 face
->strike_through_color
= face
->foreground
;
6043 face
->strike_through_color_defaulted_p
= 1;
6044 face
->strike_through_p
= 1;
6047 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6048 if (!NILP (stipple
))
6049 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6052 xassert (face
->fontset
< 0);
6053 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6055 #endif /* HAVE_X_WINDOWS */
6059 /* Realize the fully-specified face with attributes ATTRS in face
6060 cache C for character set CHARSET or for unibyte text if CHARSET <
6061 0. Do it for TTY frame C->f. Value is a pointer to the newly
6062 created realized face. */
6064 static struct face
*
6065 realize_tty_face (c
, attrs
, charset
)
6066 struct face_cache
*c
;
6073 Lisp_Object tty_defined_color_alist
=
6074 Fsymbol_value (intern ("tty-defined-color-alist"));
6075 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6077 int face_colors_defaulted
= 0;
6079 /* Frame must be a termcap frame. */
6080 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6082 /* Allocate a new realized face. */
6083 face
= make_realized_face (attrs
, charset
, Qnil
);
6084 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6086 /* Map face attributes to TTY appearances. We map slant to
6087 dimmed text because we want italic text to appear differently
6088 and because dimmed text is probably used infrequently. */
6089 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6090 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6092 if (weight
> XLFD_WEIGHT_MEDIUM
)
6093 face
->tty_bold_p
= 1;
6094 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6095 face
->tty_dim_p
= 1;
6096 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6097 face
->tty_underline_p
= 1;
6098 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6099 face
->tty_reverse_p
= 1;
6101 /* Map color names to color indices. */
6102 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6103 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6105 XSETFRAME (frame
, c
->f
);
6106 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6108 && XSTRING (color
)->size
6109 && !NILP (tty_defined_color_alist
)
6110 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6112 /* Associations in tty-defined-color-alist are of the form
6113 (NAME INDEX R G B). We need the INDEX part. */
6114 face
->foreground
= XINT (XCAR (XCDR (color
)));
6116 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6117 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6119 face
->foreground
= load_color (c
->f
, face
,
6120 attrs
[LFACE_FOREGROUND_INDEX
],
6121 LFACE_FOREGROUND_INDEX
);
6123 /* If the foreground of the default face is the default color,
6124 use the foreground color defined by the frame. */
6125 if (FRAME_MSDOS_P (c
->f
))
6127 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6128 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6130 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6131 attrs
[LFACE_FOREGROUND_INDEX
] =
6132 msdos_stdcolor_name (face
->foreground
);
6133 face_colors_defaulted
= 1;
6135 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6137 face
->foreground
= FRAME_BACKGROUND_PIXEL (f
);
6138 attrs
[LFACE_FOREGROUND_INDEX
] =
6139 msdos_stdcolor_name (face
->foreground
);
6140 face_colors_defaulted
= 1;
6146 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6148 && XSTRING (color
)->size
6149 && !NILP (tty_defined_color_alist
)
6150 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6152 /* Associations in tty-defined-color-alist are of the form
6153 (NAME INDEX R G B). We need the INDEX part. */
6154 face
->background
= XINT (XCAR (XCDR (color
)));
6156 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6157 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6159 face
->background
= load_color (c
->f
, face
,
6160 attrs
[LFACE_BACKGROUND_INDEX
],
6161 LFACE_BACKGROUND_INDEX
);
6163 /* If the background of the default face is the default color,
6164 use the background color defined by the frame. */
6165 if (FRAME_MSDOS_P (c
->f
))
6167 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6168 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6170 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6171 attrs
[LFACE_BACKGROUND_INDEX
] =
6172 msdos_stdcolor_name (face
->background
);
6173 face_colors_defaulted
= 1;
6175 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6177 face
->background
= FRAME_FOREGROUND_PIXEL (f
);
6178 attrs
[LFACE_BACKGROUND_INDEX
] =
6179 msdos_stdcolor_name (face
->background
);
6180 face_colors_defaulted
= 1;
6186 /* Swap colors if face is inverse-video. If the colors are taken
6187 from the frame colors, they are already inverted, since the
6188 frame-creation function calls x-handle-reverse-video. */
6189 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6191 unsigned long tem
= face
->foreground
;
6193 face
->foreground
= face
->background
;
6194 face
->background
= tem
;
6202 /***********************************************************************
6204 ***********************************************************************/
6206 /* Return the ID of the face to use to display character CH with face
6207 property PROP on frame F in current_buffer. */
6210 compute_char_face (f
, ch
, prop
)
6216 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6218 : CHAR_CHARSET (ch
));
6221 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6224 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6225 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6226 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6227 merge_face_vector_with_property (f
, attrs
, prop
);
6228 face_id
= lookup_face (f
, attrs
, charset
);
6235 /* Return the face ID associated with buffer position POS for
6236 displaying ASCII characters. Return in *ENDPTR the position at
6237 which a different face is needed, as far as text properties and
6238 overlays are concerned. W is a window displaying current_buffer.
6240 REGION_BEG, REGION_END delimit the region, so it can be
6243 LIMIT is a position not to scan beyond. That is to limit the time
6244 this function can take.
6246 If MOUSE is non-zero, use the character's mouse-face, not its face.
6248 The face returned is suitable for displaying CHARSET_ASCII if
6249 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6250 the face is suitable for displaying unibyte text. */
6253 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6254 endptr
, limit
, mouse
)
6257 int region_beg
, region_end
;
6262 struct frame
*f
= XFRAME (w
->frame
);
6263 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6264 Lisp_Object prop
, position
;
6266 Lisp_Object
*overlay_vec
;
6269 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6270 Lisp_Object limit1
, end
;
6271 struct face
*default_face
;
6272 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6274 /* W must display the current buffer. We could write this function
6275 to use the frame and buffer of W, but right now it doesn't. */
6276 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6278 XSETFRAME (frame
, f
);
6279 XSETFASTINT (position
, pos
);
6282 if (pos
< region_beg
&& region_beg
< endpos
)
6283 endpos
= region_beg
;
6285 /* Get the `face' or `mouse_face' text property at POS, and
6286 determine the next position at which the property changes. */
6287 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6288 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6289 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6291 endpos
= XINT (end
);
6293 /* Look at properties from overlays. */
6298 /* First try with room for 40 overlays. */
6300 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6301 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6302 &next_overlay
, NULL
);
6304 /* If there are more than 40, make enough space for all, and try
6306 if (noverlays
> len
)
6309 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6310 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6311 &next_overlay
, NULL
);
6314 if (next_overlay
< endpos
)
6315 endpos
= next_overlay
;
6320 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6322 /* Optimize common cases where we can use the default face. */
6325 && !(pos
>= region_beg
&& pos
< region_end
)
6327 || !FRAME_WINDOW_P (f
)
6328 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6329 return DEFAULT_FACE_ID
;
6331 /* Begin with attributes from the default face. */
6332 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6334 /* Merge in attributes specified via text properties. */
6336 merge_face_vector_with_property (f
, attrs
, prop
);
6338 /* Now merge the overlay data. */
6339 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6340 for (i
= 0; i
< noverlays
; i
++)
6345 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6347 merge_face_vector_with_property (f
, attrs
, prop
);
6349 oend
= OVERLAY_END (overlay_vec
[i
]);
6350 oendpos
= OVERLAY_POSITION (oend
);
6351 if (oendpos
< endpos
)
6355 /* If in the region, merge in the region face. */
6356 if (pos
>= region_beg
&& pos
< region_end
)
6358 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6359 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6361 if (region_end
< endpos
)
6362 endpos
= region_end
;
6367 /* Look up a realized face with the given face attributes,
6368 or realize a new one. Charset is ignored for tty frames. */
6369 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6373 /* Compute the face at character position POS in Lisp string STRING on
6374 window W, for charset CHARSET_ASCII.
6376 If STRING is an overlay string, it comes from position BUFPOS in
6377 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6378 not an overlay string. W must display the current buffer.
6379 REGION_BEG and REGION_END give the start and end positions of the
6380 region; both are -1 if no region is visible. BASE_FACE_ID is the
6381 id of the basic face to merge with. It is usually equal to
6382 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6383 for strings displayed in the mode or top line.
6385 Set *ENDPTR to the next position where to check for faces in
6386 STRING; -1 if the face is constant from POS to the end of the
6389 Value is the id of the face to use. The face returned is suitable
6390 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6391 the face is suitable for displaying unibyte text. */
6394 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6395 region_end
, endptr
, base_face_id
)
6399 int region_beg
, region_end
;
6401 enum face_id base_face_id
;
6403 Lisp_Object prop
, position
, end
, limit
;
6404 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6405 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6406 struct face
*base_face
;
6407 int multibyte_p
= STRING_MULTIBYTE (string
);
6409 /* Get the value of the face property at the current position within
6410 STRING. Value is nil if there is no face property. */
6411 XSETFASTINT (position
, pos
);
6412 prop
= Fget_text_property (position
, Qface
, string
);
6414 /* Get the next position at which to check for faces. Value of end
6415 is nil if face is constant all the way to the end of the string.
6416 Otherwise it is a string position where to check faces next.
6417 Limit is the maximum position up to which to check for property
6418 changes in Fnext_single_property_change. Strings are usually
6419 short, so set the limit to the end of the string. */
6420 XSETFASTINT (limit
, XSTRING (string
)->size
);
6421 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6423 *endptr
= XFASTINT (end
);
6427 base_face
= FACE_FROM_ID (f
, base_face_id
);
6428 xassert (base_face
);
6430 /* Optimize the default case that there is no face property and we
6431 are not in the region. */
6433 && (base_face_id
!= DEFAULT_FACE_ID
6434 /* BUFPOS <= 0 means STRING is not an overlay string, so
6435 that the region doesn't have to be taken into account. */
6437 || bufpos
< region_beg
6438 || bufpos
>= region_end
)
6440 /* We can't realize faces for different charsets differently
6441 if we don't have fonts, so we can stop here if not working
6442 on a window-system frame. */
6443 || !FRAME_WINDOW_P (f
)
6444 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6445 return base_face
->id
;
6447 /* Begin with attributes from the base face. */
6448 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6450 /* Merge in attributes specified via text properties. */
6452 merge_face_vector_with_property (f
, attrs
, prop
);
6454 /* If in the region, merge in the region face. */
6456 && bufpos
>= region_beg
6457 && bufpos
< region_end
)
6459 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6460 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6463 /* Look up a realized face with the given face attributes,
6464 or realize a new one. */
6465 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6470 /***********************************************************************
6472 ***********************************************************************/
6476 /* Print the contents of the realized face FACE to stderr. */
6479 dump_realized_face (face
)
6482 fprintf (stderr
, "ID: %d\n", face
->id
);
6483 #ifdef HAVE_X_WINDOWS
6484 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6486 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6488 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6489 fprintf (stderr
, "background: 0x%lx (%s)\n",
6491 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6492 fprintf (stderr
, "font_name: %s (%s)\n",
6494 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6495 #ifdef HAVE_X_WINDOWS
6496 fprintf (stderr
, "font = %p\n", face
->font
);
6498 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6499 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6500 fprintf (stderr
, "underline: %d (%s)\n",
6502 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6503 fprintf (stderr
, "hash: %d\n", face
->hash
);
6504 fprintf (stderr
, "charset: %d\n", face
->charset
);
6508 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6516 fprintf (stderr
, "font selection order: ");
6517 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6518 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6519 fprintf (stderr
, "\n");
6521 fprintf (stderr
, "alternative fonts: ");
6522 debug_print (Vface_alternative_font_family_alist
);
6523 fprintf (stderr
, "\n");
6525 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6526 Fdump_face (make_number (i
));
6531 CHECK_NUMBER (n
, 0);
6532 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6534 error ("Not a valid face");
6535 dump_realized_face (face
);
6542 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6546 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6547 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6548 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6552 #endif /* GLYPH_DEBUG != 0 */
6556 /***********************************************************************
6558 ***********************************************************************/
6563 Qface
= intern ("face");
6565 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6566 staticpro (&Qbitmap_spec_p
);
6567 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6568 staticpro (&Qframe_update_face_colors
);
6570 /* Lisp face attribute keywords. */
6571 QCfamily
= intern (":family");
6572 staticpro (&QCfamily
);
6573 QCheight
= intern (":height");
6574 staticpro (&QCheight
);
6575 QCweight
= intern (":weight");
6576 staticpro (&QCweight
);
6577 QCslant
= intern (":slant");
6578 staticpro (&QCslant
);
6579 QCunderline
= intern (":underline");
6580 staticpro (&QCunderline
);
6581 QCinverse_video
= intern (":inverse-video");
6582 staticpro (&QCinverse_video
);
6583 QCreverse_video
= intern (":reverse-video");
6584 staticpro (&QCreverse_video
);
6585 QCforeground
= intern (":foreground");
6586 staticpro (&QCforeground
);
6587 QCbackground
= intern (":background");
6588 staticpro (&QCbackground
);
6589 QCstipple
= intern (":stipple");;
6590 staticpro (&QCstipple
);
6591 QCwidth
= intern (":width");
6592 staticpro (&QCwidth
);
6593 QCfont
= intern (":font");
6594 staticpro (&QCfont
);
6595 QCbold
= intern (":bold");
6596 staticpro (&QCbold
);
6597 QCitalic
= intern (":italic");
6598 staticpro (&QCitalic
);
6599 QCoverline
= intern (":overline");
6600 staticpro (&QCoverline
);
6601 QCstrike_through
= intern (":strike-through");
6602 staticpro (&QCstrike_through
);
6603 QCbox
= intern (":box");
6606 /* Symbols used for Lisp face attribute values. */
6607 QCcolor
= intern (":color");
6608 staticpro (&QCcolor
);
6609 QCline_width
= intern (":line-width");
6610 staticpro (&QCline_width
);
6611 QCstyle
= intern (":style");
6612 staticpro (&QCstyle
);
6613 Qreleased_button
= intern ("released-button");
6614 staticpro (&Qreleased_button
);
6615 Qpressed_button
= intern ("pressed-button");
6616 staticpro (&Qpressed_button
);
6617 Qnormal
= intern ("normal");
6618 staticpro (&Qnormal
);
6619 Qultra_light
= intern ("ultra-light");
6620 staticpro (&Qultra_light
);
6621 Qextra_light
= intern ("extra-light");
6622 staticpro (&Qextra_light
);
6623 Qlight
= intern ("light");
6624 staticpro (&Qlight
);
6625 Qsemi_light
= intern ("semi-light");
6626 staticpro (&Qsemi_light
);
6627 Qsemi_bold
= intern ("semi-bold");
6628 staticpro (&Qsemi_bold
);
6629 Qbold
= intern ("bold");
6631 Qextra_bold
= intern ("extra-bold");
6632 staticpro (&Qextra_bold
);
6633 Qultra_bold
= intern ("ultra-bold");
6634 staticpro (&Qultra_bold
);
6635 Qoblique
= intern ("oblique");
6636 staticpro (&Qoblique
);
6637 Qitalic
= intern ("italic");
6638 staticpro (&Qitalic
);
6639 Qreverse_oblique
= intern ("reverse-oblique");
6640 staticpro (&Qreverse_oblique
);
6641 Qreverse_italic
= intern ("reverse-italic");
6642 staticpro (&Qreverse_italic
);
6643 Qultra_condensed
= intern ("ultra-condensed");
6644 staticpro (&Qultra_condensed
);
6645 Qextra_condensed
= intern ("extra-condensed");
6646 staticpro (&Qextra_condensed
);
6647 Qcondensed
= intern ("condensed");
6648 staticpro (&Qcondensed
);
6649 Qsemi_condensed
= intern ("semi-condensed");
6650 staticpro (&Qsemi_condensed
);
6651 Qsemi_expanded
= intern ("semi-expanded");
6652 staticpro (&Qsemi_expanded
);
6653 Qexpanded
= intern ("expanded");
6654 staticpro (&Qexpanded
);
6655 Qextra_expanded
= intern ("extra-expanded");
6656 staticpro (&Qextra_expanded
);
6657 Qultra_expanded
= intern ("ultra-expanded");
6658 staticpro (&Qultra_expanded
);
6659 Qbackground_color
= intern ("background-color");
6660 staticpro (&Qbackground_color
);
6661 Qforeground_color
= intern ("foreground-color");
6662 staticpro (&Qforeground_color
);
6663 Qunspecified
= intern ("unspecified");
6664 staticpro (&Qunspecified
);
6665 Qunspecified_fg
= intern ("unspecified-fg");
6666 staticpro (&Qunspecified_fg
);
6667 Qunspecified_bg
= intern ("unspecified-bg");
6668 staticpro (&Qunspecified_bg
);
6670 Qx_charset_registry
= intern ("x-charset-registry");
6671 staticpro (&Qx_charset_registry
);
6672 Qface_alias
= intern ("face-alias");
6673 staticpro (&Qface_alias
);
6674 Qdefault
= intern ("default");
6675 staticpro (&Qdefault
);
6676 Qtool_bar
= intern ("tool-bar");
6677 staticpro (&Qtool_bar
);
6678 Qregion
= intern ("region");
6679 staticpro (&Qregion
);
6680 Qfringe
= intern ("fringe");
6681 staticpro (&Qfringe
);
6682 Qheader_line
= intern ("header-line");
6683 staticpro (&Qheader_line
);
6684 Qscroll_bar
= intern ("scroll-bar");
6685 staticpro (&Qscroll_bar
);
6686 Qmenu
= intern ("menu");
6688 Qcursor
= intern ("cursor");
6689 staticpro (&Qcursor
);
6690 Qborder
= intern ("border");
6691 staticpro (&Qborder
);
6692 Qmouse
= intern ("mouse");
6693 staticpro (&Qmouse
);
6694 Qtty_color_desc
= intern ("tty-color-desc");
6695 staticpro (&Qtty_color_desc
);
6696 Qtty_color_by_index
= intern ("tty-color-by-index");
6697 staticpro (&Qtty_color_by_index
);
6699 defsubr (&Sinternal_make_lisp_face
);
6700 defsubr (&Sinternal_lisp_face_p
);
6701 defsubr (&Sinternal_set_lisp_face_attribute
);
6702 #ifdef HAVE_X_WINDOWS
6703 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6704 defsubr (&Sface_color_gray_p
);
6705 defsubr (&Sface_color_supported_p
);
6707 defsubr (&Sinternal_get_lisp_face_attribute
);
6708 defsubr (&Sinternal_lisp_face_attribute_values
);
6709 defsubr (&Sinternal_lisp_face_equal_p
);
6710 defsubr (&Sinternal_lisp_face_empty_p
);
6711 defsubr (&Sinternal_copy_lisp_face
);
6712 defsubr (&Sinternal_merge_in_global_face
);
6713 defsubr (&Sface_font
);
6714 defsubr (&Sframe_face_alist
);
6715 defsubr (&Sinternal_set_font_selection_order
);
6716 defsubr (&Sinternal_set_alternative_font_family_alist
);
6718 defsubr (&Sdump_face
);
6719 defsubr (&Sshow_face_resources
);
6720 #endif /* GLYPH_DEBUG */
6721 defsubr (&Sclear_face_cache
);
6723 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6724 "*Limit for font matching.\n\
6725 If an integer > 0, font matching functions won't load more than\n\
6726 that number of fonts when searching for a matching font.");
6727 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6729 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6730 "List of global face definitions (for internal use only.)");
6731 Vface_new_frame_defaults
= Qnil
;
6733 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6734 "*Default stipple pattern used on monochrome displays.\n\
6735 This stipple pattern is used on monochrome displays\n\
6736 instead of shades of gray for a face background color.\n\
6737 See `set-face-stipple' for possible values for this variable.");
6738 Vface_default_stipple
= build_string ("gray3");
6740 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6741 "Default registry and encoding to use.\n\
6742 This registry and encoding is used for unibyte text. It is set up\n\
6743 from the specified frame font when Emacs starts. (For internal use only.)");
6744 Vface_default_registry
= Qnil
;
6746 DEFVAR_LISP ("face-alternative-font-family-alist",
6747 &Vface_alternative_font_family_alist
, "");
6748 Vface_alternative_font_family_alist
= Qnil
;
6752 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6753 "Allowed scalable fonts.\n\
6754 A value of nil means don't allow any scalable fonts.\n\
6755 A value of t means allow any scalable font.\n\
6756 Otherwise, value must be a list of regular expressions. A font may be\n\
6757 scaled if its name matches a regular expression in the list.");
6758 Vscalable_fonts_allowed
= Qnil
;
6760 #endif /* SCALABLE_FONTS */
6762 #ifdef HAVE_X_WINDOWS
6763 defsubr (&Sbitmap_spec_p
);
6764 defsubr (&Sx_list_fonts
);
6765 defsubr (&Sinternal_face_x_get_resource
);
6766 defsubr (&Sx_family_fonts
);
6767 defsubr (&Sx_font_family_list
);
6768 #endif /* HAVE_X_WINDOWS */