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
;
287 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
289 /* The symbol `x-charset-registry'. This property of charsets defines
290 the X registry and encoding that fonts should have that are used to
291 display characters of that charset. */
293 Lisp_Object Qx_charset_registry
;
295 /* The name of the function to call when the background of the frame
296 has changed, frame_update_face_colors. */
298 Lisp_Object Qframe_update_face_colors
;
300 /* Names of basic faces. */
302 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
303 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
304 extern Lisp_Object Qmode_line
;
306 /* The symbol `face-alias'. A symbols having that property is an
307 alias for another face. Value of the property is the name of
310 Lisp_Object Qface_alias
;
312 /* Names of frame parameters related to faces. */
314 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
315 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
317 /* Default stipple pattern used on monochrome displays. This stipple
318 pattern is used on monochrome displays instead of shades of gray
319 for a face background color. See `set-face-stipple' for possible
320 values for this variable. */
322 Lisp_Object Vface_default_stipple
;
324 /* Default registry and encoding to use for charsets whose charset
325 symbols don't specify one. */
327 Lisp_Object Vface_default_registry
;
329 /* Alist of alternative font families. Each element is of the form
330 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
331 try FAMILY1, then FAMILY2, ... */
333 Lisp_Object Vface_alternative_font_family_alist
;
335 /* Allowed scalable fonts. A value of nil means don't allow any
336 scalable fonts. A value of t means allow the use of any scalable
337 font. Otherwise, value must be a list of regular expressions. A
338 font may be scaled if its name matches a regular expression in the
342 Lisp_Object Vscalable_fonts_allowed
;
345 /* Maximum number of fonts to consider in font_list. If not an
346 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
348 Lisp_Object Vfont_list_limit
;
349 #define DEFAULT_FONT_LIST_LIMIT 100
351 /* The symbols `foreground-color' and `background-color' which can be
352 used as part of a `face' property. This is for compatibility with
355 Lisp_Object Qforeground_color
, Qbackground_color
;
357 /* The symbols `face' and `mouse-face' used as text properties. */
360 extern Lisp_Object Qmouse_face
;
362 /* Error symbol for wrong_type_argument in load_pixmap. */
364 Lisp_Object Qbitmap_spec_p
;
366 /* Alist of global face definitions. Each element is of the form
367 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
368 is a Lisp vector of face attributes. These faces are used
369 to initialize faces for new frames. */
371 Lisp_Object Vface_new_frame_defaults
;
373 /* The next ID to assign to Lisp faces. */
375 static int next_lface_id
;
377 /* A vector mapping Lisp face Id's to face names. */
379 static Lisp_Object
*lface_id_to_name
;
380 static int lface_id_to_name_size
;
382 /* tty color-related functions (defined on lisp/term/tty-colors.el). */
383 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
385 /* Counter for calls to clear_face_cache. If this counter reaches
386 CLEAR_FONT_TABLE_COUNT, and a frame has more than
387 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
389 static int clear_font_table_count
;
390 #define CLEAR_FONT_TABLE_COUNT 100
391 #define CLEAR_FONT_TABLE_NFONTS 10
393 /* Non-zero means face attributes have been changed since the last
394 redisplay. Used in redisplay_internal. */
396 int face_change_count
;
398 /* The total number of colors currently allocated. */
401 static int ncolors_allocated
;
402 static int npixmaps_allocated
;
408 /* Function prototypes. */
413 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
414 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
415 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
416 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
418 static int first_font_matching
P_ ((struct frame
*f
, char *,
419 struct font_name
*));
420 static int x_face_list_fonts
P_ ((struct frame
*, char *,
421 struct font_name
*, int, int, int));
422 static int font_scalable_p
P_ ((struct font_name
*));
423 static Lisp_Object deduce_unibyte_registry
P_ ((struct frame
*, char *));
424 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
425 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
426 static char *xstrdup
P_ ((char *));
427 static unsigned char *xstrlwr
P_ ((unsigned char *));
428 static void signal_error
P_ ((char *, Lisp_Object
));
429 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
430 static void load_face_font_or_fontset
P_ ((struct frame
*, struct face
*, char *, int));
431 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
432 static void free_face_colors
P_ ((struct frame
*, struct face
*));
433 static int face_color_gray_p
P_ ((struct frame
*, char *));
434 static char *build_font_name
P_ ((struct font_name
*));
435 static void free_font_names
P_ ((struct font_name
*, int));
436 static int sorted_font_list
P_ ((struct frame
*, char *,
437 int (*cmpfn
) P_ ((const void *, const void *)),
438 struct font_name
**));
439 static int font_list
P_ ((struct frame
*, char *, char *, char *, struct font_name
**));
440 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, char *, char *, char *,
441 struct font_name
**));
442 static int cmp_font_names
P_ ((const void *, const void *));
443 static struct face
*realize_face
P_ ((struct face_cache
*,
444 Lisp_Object
*, int));
445 static struct face
*realize_x_face
P_ ((struct face_cache
*,
446 Lisp_Object
*, int));
447 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
448 Lisp_Object
*, int));
449 static int realize_basic_faces
P_ ((struct frame
*));
450 static int realize_default_face
P_ ((struct frame
*));
451 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
452 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
453 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
454 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
455 static unsigned lface_hash
P_ ((Lisp_Object
*));
456 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
457 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
458 static void free_realized_face
P_ ((struct frame
*, struct face
*));
459 static void clear_face_gcs
P_ ((struct face_cache
*));
460 static void free_face_cache
P_ ((struct face_cache
*));
461 static int face_numeric_weight
P_ ((Lisp_Object
));
462 static int face_numeric_slant
P_ ((Lisp_Object
));
463 static int face_numeric_swidth
P_ ((Lisp_Object
));
464 static int face_fontset
P_ ((struct frame
*, Lisp_Object
*));
465 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int,
467 static char *choose_face_fontset_font
P_ ((struct frame
*, Lisp_Object
*,
469 static void merge_face_vectors
P_ ((Lisp_Object
*from
, Lisp_Object
*));
470 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
472 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
, char *,
474 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
475 static struct face
*make_realized_face
P_ ((Lisp_Object
*, int, Lisp_Object
));
476 static void free_realized_faces
P_ ((struct face_cache
*));
477 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
478 struct font_name
*, int));
479 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
480 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
481 static int xlfd_numeric_slant
P_ ((struct font_name
*));
482 static int xlfd_numeric_weight
P_ ((struct font_name
*));
483 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
484 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
485 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
486 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
487 static int xlfd_fixed_p
P_ ((struct font_name
*));
488 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
490 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
491 struct font_name
*, int, int));
492 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
493 struct font_name
*, int));
495 #ifdef HAVE_X_WINDOWS
497 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
498 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
499 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
500 int (*cmpfn
) P_ ((const void *, const void *))));
501 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
502 static void x_free_gc
P_ ((struct frame
*, GC
));
503 static void clear_font_table
P_ ((struct frame
*));
505 #endif /* HAVE_X_WINDOWS */
508 /***********************************************************************
510 ***********************************************************************/
512 #ifdef HAVE_X_WINDOWS
514 /* Create and return a GC for use on frame F. GC values and mask
515 are given by XGCV and MASK. */
518 x_create_gc (f
, mask
, xgcv
)
525 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
532 /* Free GC which was used on frame F. */
540 xassert (--ngcs
>= 0);
541 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
545 #endif /* HAVE_X_WINDOWS */
548 /* Like strdup, but uses xmalloc. */
554 int len
= strlen (s
) + 1;
555 char *p
= (char *) xmalloc (len
);
561 /* Like stricmp. Used to compare parts of font names which are in
566 unsigned char *s1
, *s2
;
570 unsigned char c1
= tolower (*s1
);
571 unsigned char c2
= tolower (*s2
);
573 return c1
< c2
? -1 : 1;
578 return *s2
== 0 ? 0 : -1;
583 /* Like strlwr, which might not always be available. */
585 static unsigned char *
589 unsigned char *p
= s
;
598 /* Signal `error' with message S, and additional argument ARG. */
601 signal_error (s
, arg
)
605 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
609 /* If FRAME is nil, return a pointer to the selected frame.
610 Otherwise, check that FRAME is a live frame, and return a pointer
611 to it. NPARAM is the parameter number of FRAME, for
612 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
613 Lisp function definitions. */
615 static INLINE
struct frame
*
616 frame_or_selected_frame (frame
, nparam
)
621 frame
= selected_frame
;
623 CHECK_LIVE_FRAME (frame
, nparam
);
624 return XFRAME (frame
);
628 /***********************************************************************
630 ***********************************************************************/
632 /* Initialize face cache and basic faces for frame F. */
638 /* Make a face cache, if F doesn't have one. */
639 if (FRAME_FACE_CACHE (f
) == NULL
)
640 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
642 #ifdef HAVE_X_WINDOWS
643 /* Make the image cache. */
646 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
647 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
648 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
650 #endif /* HAVE_X_WINDOWS */
652 /* Realize basic faces. Must have enough information in frame
653 parameters to realize basic faces at this point. */
654 #ifdef HAVE_X_WINDOWS
655 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
657 if (!realize_basic_faces (f
))
662 /* Free face cache of frame F. Called from Fdelete_frame. */
668 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
672 free_face_cache (face_cache
);
673 FRAME_FACE_CACHE (f
) = NULL
;
676 #ifdef HAVE_X_WINDOWS
679 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
682 --image_cache
->refcount
;
683 if (image_cache
->refcount
== 0)
684 free_image_cache (f
);
687 #endif /* HAVE_X_WINDOWS */
691 /* Clear face caches, and recompute basic faces for frame F. Call
692 this after changing frame parameters on which those faces depend,
693 or when realized faces have been freed due to changing attributes
697 recompute_basic_faces (f
)
700 if (FRAME_FACE_CACHE (f
))
702 clear_face_cache (0);
703 if (!realize_basic_faces (f
))
709 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
710 try to free unused fonts, too. */
713 clear_face_cache (clear_fonts_p
)
716 #ifdef HAVE_X_WINDOWS
717 Lisp_Object tail
, frame
;
721 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
723 /* From time to time see if we can unload some fonts. This also
724 frees all realized faces on all frames. Fonts needed by
725 faces will be loaded again when faces are realized again. */
726 clear_font_table_count
= 0;
728 FOR_EACH_FRAME (tail
, frame
)
732 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
734 free_all_realized_faces (frame
);
735 clear_font_table (f
);
741 /* Clear GCs of realized faces. */
742 FOR_EACH_FRAME (tail
, frame
)
747 clear_face_gcs (FRAME_FACE_CACHE (f
));
748 clear_image_cache (f
, 0);
752 #endif /* HAVE_X_WINDOWS */
756 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
757 "Clear face caches on all frames.\n\
758 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
760 Lisp_Object thorougly
;
762 clear_face_cache (!NILP (thorougly
));
768 #ifdef HAVE_X_WINDOWS
771 /* Remove those fonts from the font table of frame F that are not used
772 by fontsets. Called from clear_face_cache from time to time. */
778 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
780 Lisp_Object rest
, frame
;
783 xassert (FRAME_X_P (f
));
785 used
= (char *) alloca (dpyinfo
->n_fonts
* sizeof *used
);
786 bzero (used
, dpyinfo
->n_fonts
* sizeof *used
);
788 /* For all frames with the same x_display_info as F, record
789 in `used' those fonts that are in use by fontsets. */
790 FOR_EACH_FRAME (rest
, frame
)
791 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
793 struct frame
*f
= XFRAME (frame
);
794 struct fontset_data
*fontset_data
= FRAME_FONTSET_DATA (f
);
796 for (i
= 0; i
< fontset_data
->n_fontsets
; ++i
)
798 struct fontset_info
*info
= fontset_data
->fontset_table
[i
];
801 for (j
= 0; j
<= MAX_CHARSET
; ++j
)
803 int idx
= info
->font_indexes
[j
];
810 /* Free those fonts that are not used by fontsets. */
811 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
812 if (used
[i
] == 0 && dpyinfo
->font_table
[i
].name
)
814 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
816 /* Free names. In xfns.c there is a comment that full_name
817 should never be freed because it is always shared with
818 something else. I don't think this is true anymore---see
819 x_load_font. It's either equal to font_info->name or
820 allocated via xmalloc, and there seems to be no place in
821 the source files where full_name is transferred to another
823 if (font_info
->full_name
!= font_info
->name
)
824 xfree (font_info
->full_name
);
825 xfree (font_info
->name
);
829 XFreeFont (dpyinfo
->display
, font_info
->font
);
832 /* Mark font table slot free. */
833 font_info
->font
= NULL
;
834 font_info
->name
= font_info
->full_name
= NULL
;
839 #endif /* HAVE_X_WINDOWS */
843 /***********************************************************************
845 ***********************************************************************/
847 #ifdef HAVE_X_WINDOWS
849 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
850 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
851 A bitmap specification is either a string, a file name, or a list\n\
852 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
853 HEIGHT is its height, and DATA is a string containing the bits of\n\
854 the pixmap. Bits are stored row by row, each row occupies\n\
855 (WIDTH + 7)/8 bytes.")
861 if (STRINGP (object
))
862 /* If OBJECT is a string, it's a file name. */
864 else if (CONSP (object
))
866 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
867 HEIGHT must be integers > 0, and DATA must be string large
868 enough to hold a bitmap of the specified size. */
869 Lisp_Object width
, height
, data
;
871 height
= width
= data
= Qnil
;
875 width
= XCAR (object
);
876 object
= XCDR (object
);
879 height
= XCAR (object
);
880 object
= XCDR (object
);
882 data
= XCAR (object
);
886 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
888 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
890 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* height
)
895 return pixmap_p
? Qt
: Qnil
;
899 /* Load a bitmap according to NAME (which is either a file name or a
900 pixmap spec) for use on frame F. Value is the bitmap_id (see
901 xfns.c). If NAME is nil, return with a bitmap id of zero. If
902 bitmap cannot be loaded, display a message saying so, and return
903 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
904 if these pointers are not null. */
907 load_pixmap (f
, name
, w_ptr
, h_ptr
)
910 unsigned int *w_ptr
, *h_ptr
;
918 tem
= Fbitmap_spec_p (name
);
920 wrong_type_argument (Qbitmap_spec_p
, name
);
925 /* Decode a bitmap spec into a bitmap. */
930 w
= XINT (Fcar (name
));
931 h
= XINT (Fcar (Fcdr (name
)));
932 bits
= Fcar (Fcdr (Fcdr (name
)));
934 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
939 /* It must be a string -- a file name. */
940 bitmap_id
= x_create_bitmap_from_file (f
, name
);
946 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
957 ++npixmaps_allocated
;
960 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
963 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
969 #endif /* HAVE_X_WINDOWS */
973 /***********************************************************************
975 ***********************************************************************/
977 #ifdef HAVE_X_WINDOWS
979 /* Update the line_height of frame F. Return non-zero if line height
983 frame_update_line_height (f
)
986 int fontset
, line_height
, changed_p
;
988 fontset
= f
->output_data
.x
->fontset
;
990 line_height
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
]->height
;
992 line_height
= FONT_HEIGHT (f
->output_data
.x
->font
);
994 changed_p
= line_height
!= f
->output_data
.x
->line_height
;
995 f
->output_data
.x
->line_height
= line_height
;
999 #endif /* HAVE_X_WINDOWS */
1002 /***********************************************************************
1004 ***********************************************************************/
1006 #ifdef HAVE_X_WINDOWS
1008 /* Load font or fontset of face FACE which is used on frame F.
1009 FONTSET is the fontset FACE should use or -1, if FACE doesn't use a
1010 fontset. FONT_NAME is the name of the font to load, if no fontset
1011 is used. It is null if no suitable font name could be determined
1015 load_face_font_or_fontset (f
, face
, font_name
, fontset
)
1021 struct font_info
*font_info
= NULL
;
1023 face
->font_info_id
= -1;
1024 face
->fontset
= fontset
;
1029 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
1032 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), face
->charset
,
1041 face
->font_info_id
= FONT_INFO_ID (f
, font_info
);
1042 face
->font
= font_info
->font
;
1043 face
->font_name
= font_info
->full_name
;
1045 /* Make the registry part of the font name readily accessible.
1046 The registry is used to find suitable faces for unibyte text. */
1047 s
= font_info
->full_name
+ strlen (font_info
->full_name
);
1049 while (i
< 2 && --s
>= font_info
->full_name
)
1053 if (!STRINGP (face
->registry
)
1054 || xstricmp (XSTRING (face
->registry
)->data
, s
+ 1) != 0)
1056 if (STRINGP (Vface_default_registry
)
1057 && !xstricmp (XSTRING (Vface_default_registry
)->data
, s
+ 1))
1058 face
->registry
= Vface_default_registry
;
1060 face
->registry
= build_string (s
+ 1);
1063 else if (fontset
>= 0)
1064 add_to_log ("Unable to load ASCII font of fontset %d",
1065 make_number (fontset
), Qnil
);
1067 add_to_log ("Unable to load font %s",
1068 build_string (font_name
), Qnil
);
1071 #endif /* HAVE_X_WINDOWS */
1075 /***********************************************************************
1077 ***********************************************************************/
1079 /* A version of defined_color for non-X frames. */
1081 tty_defined_color (f
, color_name
, color_def
, alloc
)
1087 Lisp_Object color_desc
;
1088 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
,
1089 red
= 0, green
= 0, blue
= 0;
1092 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1096 XSETFRAME (frame
, f
);
1098 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1099 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1101 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1102 if (CONSP (XCDR (XCDR (color_desc
))))
1104 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1105 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1106 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1110 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1111 /* We were called early during startup, and the colors are not
1112 yet set up in tty-defined-color-alist. Don't return a failure
1113 indication, since this produces the annoying "Unable to
1114 load color" messages in the *Messages* buffer. */
1117 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1119 if (strcmp (color_name
, "unspecified-fg") == 0)
1120 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1121 else if (strcmp (color_name
, "unspecified-bg") == 0)
1122 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1125 color_def
->pixel
= color_idx
;
1126 color_def
->red
= red
;
1127 color_def
->green
= green
;
1128 color_def
->blue
= blue
;
1133 /* Decide if color named COLOR is valid for the display associated
1134 with the frame F; if so, return the rgb values in COLOR_DEF. If
1135 ALLOC is nonzero, allocate a new colormap cell.
1137 This does the right thing for any type of frame. */
1139 defined_color (f
, color_name
, color_def
, alloc
)
1145 if (!FRAME_WINDOW_P (f
))
1146 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1147 #ifdef HAVE_X_WINDOWS
1148 else if (FRAME_X_P (f
))
1149 return x_defined_color (f
, color_name
, color_def
, alloc
);
1152 else if (FRAME_W32_P (f
))
1153 /* FIXME: w32_defined_color doesn't exist! w32fns.c defines
1154 defined_color which needs to be renamed, and the declaration
1155 of color_def therein should be changed. */
1156 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1159 else if (FRAME_MAC_P (f
))
1160 /* FIXME: mac_defined_color doesn't exist! */
1161 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1167 /* Given the index of the tty color, return its name, a Lisp string. */
1170 tty_color_name (f
, idx
)
1176 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1179 Lisp_Object coldesc
;
1181 XSETFRAME (frame
, f
);
1182 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1184 if (!NILP (coldesc
))
1185 return XCAR (coldesc
);
1188 /* We can have an MSDOG frame under -nw for a short window of
1189 opportunity before internal_terminal_init is called. DTRT. */
1190 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1191 return msdos_stdcolor_name (idx
);
1195 /* FIXME: When/if w32 supports colors in non-window mode, there should
1196 be a call here to a w32-specific function that returns the color
1197 by index using the default color mapping on a Windows console. */
1200 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1201 return build_string (unspecified_fg
);
1202 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1203 return build_string (unspecified_bg
);
1204 return Qunspecified
;
1207 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1208 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1211 face_color_gray_p (f
, color_name
)
1218 if (defined_color (f
, color_name
, &color
, 0))
1219 gray_p
= ((abs (color
.red
- color
.green
)
1220 < max (color
.red
, color
.green
) / 20)
1221 && (abs (color
.green
- color
.blue
)
1222 < max (color
.green
, color
.blue
) / 20)
1223 && (abs (color
.blue
- color
.red
)
1224 < max (color
.blue
, color
.red
) / 20));
1232 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1233 BACKGROUND_P non-zero means the color will be used as background
1237 face_color_supported_p (f
, color_name
, background_p
)
1245 XSETFRAME (frame
, f
);
1246 return (FRAME_WINDOW_P (f
)
1247 ? (!NILP (Fxw_display_color_p (frame
))
1248 || xstricmp (color_name
, "black") == 0
1249 || xstricmp (color_name
, "white") == 0
1251 && face_color_gray_p (f
, color_name
))
1252 || (!NILP (Fx_display_grayscale_p (frame
))
1253 && face_color_gray_p (f
, color_name
)))
1254 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1258 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1259 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1260 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1261 If FRAME is nil or omitted, use the selected frame.")
1263 Lisp_Object color
, frame
;
1267 CHECK_FRAME (frame
, 0);
1268 CHECK_STRING (color
, 0);
1270 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1274 DEFUN ("color-supported-p", Fcolor_supported_p
,
1275 Scolor_supported_p
, 2, 3, 0,
1276 "Return non-nil if COLOR can be displayed on FRAME.\n\
1277 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1278 If FRAME is nil or omitted, use the selected frame.\n\
1279 COLOR must be a valid color name.")
1280 (color
, frame
, background_p
)
1281 Lisp_Object frame
, color
, background_p
;
1285 CHECK_FRAME (frame
, 0);
1286 CHECK_STRING (color
, 0);
1288 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1293 /* Load color with name NAME for use by face FACE on frame F.
1294 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1295 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1296 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1297 pixel color. If color cannot be loaded, display a message, and
1298 return the foreground, background or underline color of F, but
1299 record that fact in flags of the face so that we don't try to free
1303 load_color (f
, face
, name
, target_index
)
1307 enum lface_attribute_index target_index
;
1311 xassert (STRINGP (name
));
1312 xassert (target_index
== LFACE_FOREGROUND_INDEX
1313 || target_index
== LFACE_BACKGROUND_INDEX
1314 || target_index
== LFACE_UNDERLINE_INDEX
1315 || target_index
== LFACE_OVERLINE_INDEX
1316 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1317 || target_index
== LFACE_BOX_INDEX
);
1319 /* if the color map is full, defined_color will return a best match
1320 to the values in an existing cell. */
1321 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1323 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1325 switch (target_index
)
1327 case LFACE_FOREGROUND_INDEX
:
1328 face
->foreground_defaulted_p
= 1;
1329 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1332 case LFACE_BACKGROUND_INDEX
:
1333 face
->background_defaulted_p
= 1;
1334 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1337 case LFACE_UNDERLINE_INDEX
:
1338 face
->underline_defaulted_p
= 1;
1339 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1342 case LFACE_OVERLINE_INDEX
:
1343 face
->overline_color_defaulted_p
= 1;
1344 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1347 case LFACE_STRIKE_THROUGH_INDEX
:
1348 face
->strike_through_color_defaulted_p
= 1;
1349 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1352 case LFACE_BOX_INDEX
:
1353 face
->box_color_defaulted_p
= 1;
1354 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1363 ++ncolors_allocated
;
1369 #ifdef HAVE_X_WINDOWS
1371 /* Load colors for face FACE which is used on frame F. Colors are
1372 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1373 of ATTRS. If the background color specified is not supported on F,
1374 try to emulate gray colors with a stipple from Vface_default_stipple. */
1377 load_face_colors (f
, face
, attrs
)
1384 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1385 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1387 /* Swap colors if face is inverse-video. */
1388 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1396 /* Check for support for foreground, not for background because
1397 face_color_supported_p is smart enough to know that grays are
1398 "supported" as background because we are supposed to use stipple
1400 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1401 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1403 x_destroy_bitmap (f
, face
->stipple
);
1404 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1405 &face
->pixmap_w
, &face
->pixmap_h
);
1408 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1409 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1413 /* Free color PIXEL on frame F. */
1416 unload_color (f
, pixel
)
1418 unsigned long pixel
;
1420 Display
*dpy
= FRAME_X_DISPLAY (f
);
1421 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1423 if (pixel
== BLACK_PIX_DEFAULT (f
)
1424 || pixel
== WHITE_PIX_DEFAULT (f
))
1429 /* If display has an immutable color map, freeing colors is not
1430 necessary and some servers don't allow it. So don't do it. */
1431 if (! (class == StaticColor
|| class == StaticGray
|| class == TrueColor
))
1433 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1434 XFreeColors (dpy
, cmap
, &pixel
, 1, 0);
1441 /* Free colors allocated for FACE. */
1444 free_face_colors (f
, face
)
1448 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
1450 /* If display has an immutable color map, freeing colors is not
1451 necessary and some servers don't allow it. So don't do it. */
1452 if (class != StaticColor
1453 && class != StaticGray
1454 && class != TrueColor
)
1460 dpy
= FRAME_X_DISPLAY (f
);
1461 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
1463 if (face
->foreground
!= BLACK_PIX_DEFAULT (f
)
1464 && face
->foreground
!= WHITE_PIX_DEFAULT (f
)
1465 && !face
->foreground_defaulted_p
)
1467 XFreeColors (dpy
, cmap
, &face
->foreground
, 1, 0);
1468 IF_DEBUG (--ncolors_allocated
);
1471 if (face
->background
!= BLACK_PIX_DEFAULT (f
)
1472 && face
->background
!= WHITE_PIX_DEFAULT (f
)
1473 && !face
->background_defaulted_p
)
1475 XFreeColors (dpy
, cmap
, &face
->background
, 1, 0);
1476 IF_DEBUG (--ncolors_allocated
);
1479 if (face
->underline_p
1480 && !face
->underline_defaulted_p
1481 && face
->underline_color
!= BLACK_PIX_DEFAULT (f
)
1482 && face
->underline_color
!= WHITE_PIX_DEFAULT (f
))
1484 XFreeColors (dpy
, cmap
, &face
->underline_color
, 1, 0);
1485 IF_DEBUG (--ncolors_allocated
);
1488 if (face
->overline_p
1489 && !face
->overline_color_defaulted_p
1490 && face
->overline_color
!= BLACK_PIX_DEFAULT (f
)
1491 && face
->overline_color
!= WHITE_PIX_DEFAULT (f
))
1493 XFreeColors (dpy
, cmap
, &face
->overline_color
, 1, 0);
1494 IF_DEBUG (--ncolors_allocated
);
1497 if (face
->strike_through_p
1498 && !face
->strike_through_color_defaulted_p
1499 && face
->strike_through_color
!= BLACK_PIX_DEFAULT (f
)
1500 && face
->strike_through_color
!= WHITE_PIX_DEFAULT (f
))
1502 XFreeColors (dpy
, cmap
, &face
->strike_through_color
, 1, 0);
1503 IF_DEBUG (--ncolors_allocated
);
1506 if (face
->box
!= FACE_NO_BOX
1507 && !face
->box_color_defaulted_p
1508 && face
->box_color
!= BLACK_PIX_DEFAULT (f
)
1509 && face
->box_color
!= WHITE_PIX_DEFAULT (f
))
1511 XFreeColors (dpy
, cmap
, &face
->box_color
, 1, 0);
1512 IF_DEBUG (--ncolors_allocated
);
1518 #endif /* HAVE_X_WINDOWS */
1522 /***********************************************************************
1524 ***********************************************************************/
1526 /* An enumerator for each field of an XLFD font name. */
1547 /* An enumerator for each possible slant value of a font. Taken from
1548 the XLFD specification. */
1556 XLFD_SLANT_REVERSE_ITALIC
,
1557 XLFD_SLANT_REVERSE_OBLIQUE
,
1561 /* Relative font weight according to XLFD documentation. */
1565 XLFD_WEIGHT_UNKNOWN
,
1566 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1567 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1568 XLFD_WEIGHT_LIGHT
, /* 30 */
1569 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1570 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1571 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1572 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1573 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1574 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1577 /* Relative proportionate width. */
1581 XLFD_SWIDTH_UNKNOWN
,
1582 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1583 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1584 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1585 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1586 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1587 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1588 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1589 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1590 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1593 /* Structure used for tables mapping XLFD weight, slant, and width
1594 names to numeric and symbolic values. */
1600 Lisp_Object
*symbol
;
1603 /* Table of XLFD slant names and their numeric and symbolic
1604 representations. This table must be sorted by slant names in
1607 static struct table_entry slant_table
[] =
1609 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1610 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1611 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1612 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1613 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1614 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1617 /* Table of XLFD weight names. This table must be sorted by weight
1618 names in ascending order. */
1620 static struct table_entry weight_table
[] =
1622 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1623 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1624 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1625 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1626 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1627 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1628 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1629 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1630 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1631 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1632 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1633 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1634 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1635 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1636 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1639 /* Table of XLFD width names. This table must be sorted by width
1640 names in ascending order. */
1642 static struct table_entry swidth_table
[] =
1644 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1645 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1646 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1647 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1648 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1649 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1650 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1651 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1652 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1653 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1654 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1655 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1656 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1657 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1658 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1661 /* Structure used to hold the result of splitting font names in XLFD
1662 format into their fields. */
1666 /* The original name which is modified destructively by
1667 split_font_name. The pointer is kept here to be able to free it
1668 if it was allocated from the heap. */
1671 /* Font name fields. Each vector element points into `name' above.
1672 Fields are NUL-terminated. */
1673 char *fields
[XLFD_LAST
];
1675 /* Numeric values for those fields that interest us. See
1676 split_font_name for which these are. */
1677 int numeric
[XLFD_LAST
];
1680 /* The frame in effect when sorting font names. Set temporarily in
1681 sort_fonts so that it is available in font comparison functions. */
1683 static struct frame
*font_frame
;
1685 /* Order by which font selection chooses fonts. The default values
1686 mean `first, find a best match for the font width, then for the
1687 font height, then for weight, then for slant.' This variable can be
1688 set via set-face-font-sort-order. */
1690 static int font_sort_order
[4];
1693 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1694 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1695 is a pointer to the matching table entry or null if no table entry
1698 static struct table_entry
*
1699 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1700 struct table_entry
*table
;
1702 struct font_name
*font
;
1705 /* Function split_font_name converts fields to lower-case, so there
1706 is no need to use xstrlwr or xstricmp here. */
1707 char *s
= font
->fields
[field_index
];
1708 int low
, mid
, high
, cmp
;
1715 mid
= (low
+ high
) / 2;
1716 cmp
= strcmp (table
[mid
].name
, s
);
1730 /* Return a numeric representation for font name field
1731 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1732 has DIM entries. Value is the numeric value found or DFLT if no
1733 table entry matches. This function is used to translate weight,
1734 slant, and swidth names of XLFD font names to numeric values. */
1737 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1738 struct table_entry
*table
;
1740 struct font_name
*font
;
1744 struct table_entry
*p
;
1745 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1746 return p
? p
->numeric
: dflt
;
1750 /* Return a symbolic representation for font name field
1751 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1752 has DIM entries. Value is the symbolic value found or DFLT if no
1753 table entry matches. This function is used to translate weight,
1754 slant, and swidth names of XLFD font names to symbols. */
1756 static INLINE Lisp_Object
1757 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1758 struct table_entry
*table
;
1760 struct font_name
*font
;
1764 struct table_entry
*p
;
1765 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1766 return p
? *p
->symbol
: dflt
;
1770 /* Return a numeric value for the slant of the font given by FONT. */
1773 xlfd_numeric_slant (font
)
1774 struct font_name
*font
;
1776 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1777 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1781 /* Return a symbol representing the weight of the font given by FONT. */
1783 static INLINE Lisp_Object
1784 xlfd_symbolic_slant (font
)
1785 struct font_name
*font
;
1787 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1788 font
, XLFD_SLANT
, Qnormal
);
1792 /* Return a numeric value for the weight of the font given by FONT. */
1795 xlfd_numeric_weight (font
)
1796 struct font_name
*font
;
1798 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1799 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1803 /* Return a symbol representing the slant of the font given by FONT. */
1805 static INLINE Lisp_Object
1806 xlfd_symbolic_weight (font
)
1807 struct font_name
*font
;
1809 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1810 font
, XLFD_WEIGHT
, Qnormal
);
1814 /* Return a numeric value for the swidth of the font whose XLFD font
1815 name fields are found in FONT. */
1818 xlfd_numeric_swidth (font
)
1819 struct font_name
*font
;
1821 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1822 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1826 /* Return a symbolic value for the swidth of FONT. */
1828 static INLINE Lisp_Object
1829 xlfd_symbolic_swidth (font
)
1830 struct font_name
*font
;
1832 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1833 font
, XLFD_SWIDTH
, Qnormal
);
1837 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1838 entries. Value is a pointer to the matching table entry or null if
1839 no element of TABLE contains SYMBOL. */
1841 static struct table_entry
*
1842 face_value (table
, dim
, symbol
)
1843 struct table_entry
*table
;
1849 xassert (SYMBOLP (symbol
));
1851 for (i
= 0; i
< dim
; ++i
)
1852 if (EQ (*table
[i
].symbol
, symbol
))
1855 return i
< dim
? table
+ i
: NULL
;
1859 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
1860 entries. Value is -1 if SYMBOL is not found in TABLE. */
1863 face_numeric_value (table
, dim
, symbol
)
1864 struct table_entry
*table
;
1868 struct table_entry
*p
= face_value (table
, dim
, symbol
);
1869 return p
? p
->numeric
: -1;
1873 /* Return a numeric value representing the weight specified by Lisp
1874 symbol WEIGHT. Value is one of the enumerators of enum
1878 face_numeric_weight (weight
)
1881 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
1885 /* Return a numeric value representing the slant specified by Lisp
1886 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
1889 face_numeric_slant (slant
)
1892 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
1896 /* Return a numeric value representing the swidth specified by Lisp
1897 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
1900 face_numeric_swidth (width
)
1903 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
1907 #ifdef HAVE_X_WINDOWS
1909 /* Return non-zero if FONT is the name of a fixed-pitch font. */
1913 struct font_name
*font
;
1915 /* Function split_font_name converts fields to lower-case, so there
1916 is no need to use tolower here. */
1917 return *font
->fields
[XLFD_SPACING
] != 'p';
1921 /* Return the point size of FONT on frame F, measured in 1/10 pt.
1923 The actual height of the font when displayed on F depends on the
1924 resolution of both the font and frame. For example, a 10pt font
1925 designed for a 100dpi display will display larger than 10pt on a
1926 75dpi display. (It's not unusual to use fonts not designed for the
1927 display one is using. For example, some intlfonts are available in
1928 72dpi versions, only.)
1930 Value is the real point size of FONT on frame F, or 0 if it cannot
1934 xlfd_point_size (f
, font
)
1936 struct font_name
*font
;
1938 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
1939 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
1940 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
1943 if (font_resy
== 0 || font_pt
== 0)
1946 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
1952 /* Split XLFD font name FONT->name destructively into NUL-terminated,
1953 lower-case fields in FONT->fields. NUMERIC_P non-zero means
1954 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
1955 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
1956 zero if the font name doesn't have the format we expect. The
1957 expected format is a font name that starts with a `-' and has
1958 XLFD_LAST fields separated by `-'. (The XLFD specification allows
1959 forms of font names where certain field contents are enclosed in
1960 square brackets. We don't support that, for now. */
1963 split_font_name (f
, font
, numeric_p
)
1965 struct font_name
*font
;
1971 if (*font
->name
== '-')
1973 char *p
= xstrlwr (font
->name
) + 1;
1975 while (i
< XLFD_LAST
)
1977 font
->fields
[i
] = p
;
1980 while (*p
&& *p
!= '-')
1990 success_p
= i
== XLFD_LAST
;
1992 /* If requested, and font name was in the expected format,
1993 compute numeric values for some fields. */
1994 if (numeric_p
&& success_p
)
1996 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
1997 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
1998 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
1999 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2000 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2007 /* Build an XLFD font name from font name fields in FONT. Value is a
2008 pointer to the font name, which is allocated via xmalloc. */
2011 build_font_name (font
)
2012 struct font_name
*font
;
2016 char *font_name
= (char *) xmalloc (size
);
2017 int total_length
= 0;
2019 for (i
= 0; i
< XLFD_LAST
; ++i
)
2021 /* Add 1 because of the leading `-'. */
2022 int len
= strlen (font
->fields
[i
]) + 1;
2024 /* Reallocate font_name if necessary. Add 1 for the final
2026 if (total_length
+ len
+ 1 >= size
)
2028 int new_size
= max (2 * size
, size
+ len
+ 1);
2029 int sz
= new_size
* sizeof *font_name
;
2030 font_name
= (char *) xrealloc (font_name
, sz
);
2034 font_name
[total_length
] = '-';
2035 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2036 total_length
+= len
;
2039 font_name
[total_length
] = 0;
2044 /* Free an array FONTS of N font_name structures. This frees FONTS
2045 itself and all `name' fields in its elements. */
2048 free_font_names (fonts
, n
)
2049 struct font_name
*fonts
;
2053 xfree (fonts
[--n
].name
);
2058 /* Sort vector FONTS of font_name structures which contains NFONTS
2059 elements using qsort and comparison function CMPFN. F is the frame
2060 on which the fonts will be used. The global variable font_frame
2061 is temporarily set to F to make it available in CMPFN. */
2064 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2066 struct font_name
*fonts
;
2068 int (*cmpfn
) P_ ((const void *, const void *));
2071 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2076 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2077 display in x_display_list. FONTS is a pointer to a vector of
2078 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2079 alternative patterns from Valternate_fontname_alist if no fonts are
2080 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2083 For all fonts found, set FONTS[i].name to the name of the font,
2084 allocated via xmalloc, and split font names into fields. Ignore
2085 fonts that we can't parse. Value is the number of fonts found.
2087 This is similar to x_list_fonts. The differences are:
2089 1. It avoids consing.
2090 2. It never calls XLoadQueryFont. */
2093 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2097 struct font_name
*fonts
;
2098 int nfonts
, try_alternatives_p
;
2099 int scalable_fonts_p
;
2101 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2105 /* Get the list of fonts matching PATTERN from the X server. */
2107 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2112 /* Make a copy of the font names we got from X, and
2113 split them into fields. */
2114 for (i
= j
= 0; i
< n
; ++i
)
2116 /* Make a copy of the font name. */
2117 fonts
[j
].name
= xstrdup (names
[i
]);
2119 /* Ignore fonts having a name that we can't parse. */
2120 if (!split_font_name (f
, fonts
+ j
, 1))
2121 xfree (fonts
[j
].name
);
2122 else if (font_scalable_p (fonts
+ j
))
2125 if (!scalable_fonts_p
2126 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2127 xfree (fonts
[j
].name
);
2130 #else /* !SCALABLE_FONTS */
2131 /* Always ignore scalable fonts. */
2132 xfree (fonts
[j
].name
);
2133 #endif /* !SCALABLE_FONTS */
2141 /* Free font names. */
2143 XFreeFontNames (names
);
2148 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2149 if (n
== 0 && try_alternatives_p
)
2151 Lisp_Object list
= Valternate_fontname_alist
;
2153 while (CONSP (list
))
2155 Lisp_Object entry
= XCAR (list
);
2157 && STRINGP (XCAR (entry
))
2158 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2165 Lisp_Object patterns
= XCAR (list
);
2168 while (CONSP (patterns
)
2169 /* If list is screwed up, give up. */
2170 && (name
= XCAR (patterns
),
2172 /* Ignore patterns equal to PATTERN because we tried that
2173 already with no success. */
2174 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2175 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2179 patterns
= XCDR (patterns
);
2187 /* Determine the first font matching PATTERN on frame F. Return in
2188 *FONT the matching font name, split into fields. Value is non-zero
2189 if a match was found. */
2192 first_font_matching (f
, pattern
, font
)
2195 struct font_name
*font
;
2198 struct font_name
*fonts
;
2200 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2201 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2205 bcopy (&fonts
[0], font
, sizeof *font
);
2207 fonts
[0].name
= NULL
;
2208 free_font_names (fonts
, nfonts
);
2215 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2216 using comparison function CMPFN. Value is the number of fonts
2217 found. If value is non-zero, *FONTS is set to a vector of
2218 font_name structures allocated from the heap containing matching
2219 fonts. Each element of *FONTS contains a name member that is also
2220 allocated from the heap. Font names in these structures are split
2221 into fields. Use free_font_names to free such an array. */
2224 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2227 int (*cmpfn
) P_ ((const void *, const void *));
2228 struct font_name
**fonts
;
2232 /* Get the list of fonts matching pattern. 100 should suffice. */
2233 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2234 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2235 nfonts
= XFASTINT (Vfont_list_limit
);
2237 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2239 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2241 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 0);
2244 /* Sort the resulting array and return it in *FONTS. If no
2245 fonts were found, make sure to set *FONTS to null. */
2247 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2258 /* Compare two font_name structures *A and *B. Value is analogous to
2259 strcmp. Sort order is given by the global variable
2260 font_sort_order. Font names are sorted so that, everything else
2261 being equal, fonts with a resolution closer to that of the frame on
2262 which they are used are listed first. The global variable
2263 font_frame is the frame on which we operate. */
2266 cmp_font_names (a
, b
)
2269 struct font_name
*x
= (struct font_name
*) a
;
2270 struct font_name
*y
= (struct font_name
*) b
;
2273 /* All strings have been converted to lower-case by split_font_name,
2274 so we can use strcmp here. */
2275 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2280 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2282 int j
= font_sort_order
[i
];
2283 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2288 /* Everything else being equal, we prefer fonts with an
2289 y-resolution closer to that of the frame. */
2290 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2291 int x_resy
= x
->numeric
[XLFD_RESY
];
2292 int y_resy
= y
->numeric
[XLFD_RESY
];
2293 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2301 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2302 is non-null list fonts matching that pattern. Otherwise, if
2303 REGISTRY_AND_ENCODING is non-null return only fonts with that
2304 registry and encoding, otherwise return fonts of any registry and
2305 encoding. Set *FONTS to a vector of font_name structures allocated
2306 from the heap containing the fonts found. Value is the number of
2310 font_list (f
, pattern
, family
, registry_and_encoding
, fonts
)
2314 char *registry_and_encoding
;
2315 struct font_name
**fonts
;
2317 if (pattern
== NULL
)
2322 if (registry_and_encoding
== NULL
)
2323 registry_and_encoding
= "*";
2325 pattern
= (char *) alloca (strlen (family
)
2326 + strlen (registry_and_encoding
)
2328 if (index (family
, '-'))
2329 sprintf (pattern
, "-%s-*-%s", family
, registry_and_encoding
);
2331 sprintf (pattern
, "-*-%s-*-%s", family
, registry_and_encoding
);
2334 return sorted_font_list (f
, pattern
, cmp_font_names
, fonts
);
2338 /* Remove elements from LIST whose cars are `equal'. Called from
2339 x-family-fonts and x-font-family-list to remove duplicate font
2343 remove_duplicates (list
)
2346 Lisp_Object tail
= list
;
2348 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2350 Lisp_Object next
= XCDR (tail
);
2351 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2352 XCDR (tail
) = XCDR (next
);
2359 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2360 "Return a list of available fonts of family FAMILY on FRAME.\n\
2361 If FAMILY is omitted or nil, list all families.\n\
2362 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2364 If FRAME is omitted or nil, use the selected frame.\n\
2365 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2366 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2367 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2368 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2369 width, weight and slant of the font. These symbols are the same as for\n\
2370 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2371 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2372 giving the registry and encoding of the font.\n\
2373 The result list is sorted according to the current setting of\n\
2374 the face font sort order.")
2376 Lisp_Object family
, frame
;
2378 struct frame
*f
= check_x_frame (frame
);
2379 struct font_name
*fonts
;
2382 struct gcpro gcpro1
;
2383 char *family_pattern
;
2386 family_pattern
= "*";
2389 CHECK_STRING (family
, 1);
2390 family_pattern
= LSTRDUPA (family
);
2395 nfonts
= font_list (f
, NULL
, family_pattern
, NULL
, &fonts
);
2396 for (i
= nfonts
- 1; i
>= 0; --i
)
2398 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2401 #define ASET(VECTOR, IDX, VAL) (XVECTOR (VECTOR)->contents[IDX] = (VAL))
2403 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2404 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2405 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2406 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2407 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2408 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2409 tem
= build_font_name (fonts
+ i
);
2410 ASET (v
, 6, build_string (tem
));
2411 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2412 fonts
[i
].fields
[XLFD_ENCODING
]);
2413 ASET (v
, 7, build_string (tem
));
2416 result
= Fcons (v
, result
);
2421 remove_duplicates (result
);
2422 free_font_names (fonts
, nfonts
);
2428 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2430 "Return a list of available font families on FRAME.\n\
2431 If FRAME is omitted or nil, use the selected frame.\n\
2432 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2433 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2438 struct frame
*f
= check_x_frame (frame
);
2440 struct font_name
*fonts
;
2442 struct gcpro gcpro1
;
2443 int count
= specpdl_ptr
- specpdl
;
2446 /* Let's consider all fonts. Increase the limit for matching
2447 fonts until we have them all. */
2450 specbind (intern ("font-list-limit"), make_number (limit
));
2451 nfonts
= font_list (f
, NULL
, "*", NULL
, &fonts
);
2453 if (nfonts
== limit
)
2455 free_font_names (fonts
, nfonts
);
2464 for (i
= nfonts
- 1; i
>= 0; --i
)
2465 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2466 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2469 remove_duplicates (result
);
2470 free_font_names (fonts
, nfonts
);
2472 return unbind_to (count
, result
);
2476 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2477 "Return a list of the names of available fonts matching PATTERN.\n\
2478 If optional arguments FACE and FRAME are specified, return only fonts\n\
2479 the same size as FACE on FRAME.\n\
2480 PATTERN is a string, perhaps with wildcard characters;\n\
2481 the * character matches any substring, and\n\
2482 the ? character matches any single character.\n\
2483 PATTERN is case-insensitive.\n\
2484 FACE is a face name--a symbol.\n\
2486 The return value is a list of strings, suitable as arguments to\n\
2489 Fonts Emacs can't use may or may not be excluded\n\
2490 even if they match PATTERN and FACE.\n\
2491 The optional fourth argument MAXIMUM sets a limit on how many\n\
2492 fonts to match. The first MAXIMUM fonts are reported.\n\
2493 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2494 occupied by a character of a font. In that case, return only fonts\n\
2495 the WIDTH times as wide as FACE on FRAME.")
2496 (pattern
, face
, frame
, maximum
, width
)
2497 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2504 CHECK_STRING (pattern
, 0);
2510 CHECK_NATNUM (maximum
, 0);
2511 maxnames
= XINT (maximum
);
2515 CHECK_NUMBER (width
, 4);
2517 /* We can't simply call check_x_frame because this function may be
2518 called before any frame is created. */
2519 f
= frame_or_selected_frame (frame
, 2);
2522 /* Perhaps we have not yet created any frame. */
2527 /* Determine the width standard for comparison with the fonts we find. */
2533 /* This is of limited utility since it works with character
2534 widths. Keep it for compatibility. --gerd. */
2535 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
2536 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2539 size
= face
->font
->max_bounds
.width
;
2541 size
= FRAME_FONT (f
)->max_bounds
.width
;
2544 size
*= XINT (width
);
2548 Lisp_Object args
[2];
2550 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2552 /* We don't have to check fontsets. */
2554 args
[1] = list_fontsets (f
, pattern
, size
);
2555 return Fnconc (2, args
);
2559 #endif /* HAVE_X_WINDOWS */
2563 /***********************************************************************
2565 ***********************************************************************/
2567 /* Access face attributes of face FACE, a Lisp vector. */
2569 #define LFACE_FAMILY(LFACE) \
2570 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2571 #define LFACE_HEIGHT(LFACE) \
2572 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2573 #define LFACE_WEIGHT(LFACE) \
2574 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2575 #define LFACE_SLANT(LFACE) \
2576 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2577 #define LFACE_UNDERLINE(LFACE) \
2578 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2579 #define LFACE_INVERSE(LFACE) \
2580 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2581 #define LFACE_FOREGROUND(LFACE) \
2582 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2583 #define LFACE_BACKGROUND(LFACE) \
2584 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2585 #define LFACE_STIPPLE(LFACE) \
2586 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2587 #define LFACE_SWIDTH(LFACE) \
2588 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2589 #define LFACE_OVERLINE(LFACE) \
2590 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2591 #define LFACE_STRIKE_THROUGH(LFACE) \
2592 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2593 #define LFACE_BOX(LFACE) \
2594 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2596 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2597 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2599 #define LFACEP(LFACE) \
2601 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2602 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2607 /* Check consistency of Lisp face attribute vector ATTRS. */
2610 check_lface_attrs (attrs
)
2613 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2614 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2615 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2616 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2617 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2618 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]));
2619 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2620 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2621 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2622 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2623 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2624 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2625 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2626 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2627 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2628 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2629 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2630 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2631 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2632 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2633 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2634 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2635 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2636 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2637 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2638 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2639 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2640 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2641 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2642 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2643 #ifdef HAVE_WINDOW_SYSTEM
2644 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2645 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2646 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2651 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2659 xassert (LFACEP (lface
));
2660 check_lface_attrs (XVECTOR (lface
)->contents
);
2664 #else /* GLYPH_DEBUG == 0 */
2666 #define check_lface_attrs(attrs) (void) 0
2667 #define check_lface(lface) (void) 0
2669 #endif /* GLYPH_DEBUG == 0 */
2672 /* Resolve face name FACE_NAME. If FACE_NAME Is a string, intern it
2673 to make it a symvol. If FACE_NAME is an alias for another face,
2674 return that face's name. */
2677 resolve_face_name (face_name
)
2678 Lisp_Object face_name
;
2680 Lisp_Object aliased
;
2682 if (STRINGP (face_name
))
2683 face_name
= intern (XSTRING (face_name
)->data
);
2687 aliased
= Fget (face_name
, Qface_alias
);
2691 face_name
= aliased
;
2698 /* Return the face definition of FACE_NAME on frame F. F null means
2699 return the global definition. FACE_NAME may be a string or a
2700 symbol (apparently Emacs 20.2 allows strings as face names in face
2701 text properties; ediff uses that). If FACE_NAME is an alias for
2702 another face, return that face's definition. If SIGNAL_P is
2703 non-zero, signal an error if FACE_NAME is not a valid face name.
2704 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2707 static INLINE Lisp_Object
2708 lface_from_face_name (f
, face_name
, signal_p
)
2710 Lisp_Object face_name
;
2715 face_name
= resolve_face_name (face_name
);
2718 lface
= assq_no_quit (face_name
, f
->face_alist
);
2720 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2723 lface
= XCDR (lface
);
2725 signal_error ("Invalid face", face_name
);
2727 check_lface (lface
);
2732 /* Get face attributes of face FACE_NAME from frame-local faces on
2733 frame F. Store the resulting attributes in ATTRS which must point
2734 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2735 is non-zero, signal an error if FACE_NAME does not name a face.
2736 Otherwise, value is zero if FACE_NAME is not a face. */
2739 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2741 Lisp_Object face_name
;
2748 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2751 bcopy (XVECTOR (lface
)->contents
, attrs
,
2752 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2762 /* Non-zero if all attributes in face attribute vector ATTRS are
2763 specified, i.e. are non-nil. */
2766 lface_fully_specified_p (attrs
)
2771 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2772 if (UNSPECIFIEDP (attrs
[i
]))
2775 return i
== LFACE_VECTOR_SIZE
;
2779 #ifdef HAVE_X_WINDOWS
2781 /* Set font-related attributes of Lisp face LFACE from XLFD font name
2782 FONT_NAME. If FORCE_P is zero, set only unspecified attributes of
2783 LFACE. MAY_FAIL_P non-zero means return 0 if FONT_NAME isn't a
2784 valid font name; otherwise this function tries to use a reasonable
2787 Ignore fields of FONT_NAME containing wildcards. Value is zero if
2788 not successful because FONT_NAME was not in a valid format and
2789 MAY_FAIL_P was non-zero. A valid format is one that is suitable
2790 for split_font_name, see the comment there. */
2793 set_lface_from_font_name (f
, lface
, font_name
, force_p
, may_fail_p
)
2797 int force_p
, may_fail_p
;
2799 struct font_name font
;
2802 int free_font_name_p
= 0;
2803 int have_font_p
= 0;
2805 /* If FONT_NAME contains wildcards, use the first matching font. */
2806 if (index (font_name
, '*') || index (font_name
, '?'))
2808 if (first_font_matching (f
, font_name
, &font
))
2809 free_font_name_p
= have_font_p
= 1;
2813 font
.name
= STRDUPA (font_name
);
2814 if (split_font_name (f
, &font
, 1))
2818 /* The font name may be something like `6x13'. Make
2819 sure we use the full name. */
2820 struct font_info
*font_info
;
2823 font_info
= fs_load_font (f
, FRAME_X_FONT_TABLE (f
),
2824 CHARSET_ASCII
, font_name
, -1);
2827 font
.name
= STRDUPA (font_info
->full_name
);
2828 split_font_name (f
, &font
, 1);
2835 /* If FONT_NAME is completely bogus try to use something reasonable
2836 if this function must succeed. Otherwise, give up. */
2841 else if (first_font_matching (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
2843 || first_font_matching (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2845 || first_font_matching (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
2847 || first_font_matching (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
2849 || first_font_matching (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
2851 || first_font_matching (f
, "fixed", &font
))
2852 free_font_name_p
= 1;
2858 /* Set attributes only if unspecified, otherwise face defaults for
2859 new frames would never take effect. */
2861 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2863 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
2864 + strlen (font
.fields
[XLFD_FOUNDRY
])
2866 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
2867 font
.fields
[XLFD_FAMILY
]);
2868 LFACE_FAMILY (lface
) = build_string (buffer
);
2871 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2873 pt
= xlfd_point_size (f
, &font
);
2875 LFACE_HEIGHT (lface
) = make_number (pt
);
2878 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2879 LFACE_SWIDTH (lface
) = xlfd_symbolic_swidth (&font
);
2881 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2882 LFACE_WEIGHT (lface
) = xlfd_symbolic_weight (&font
);
2884 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2885 LFACE_SLANT (lface
) = xlfd_symbolic_slant (&font
);
2887 if (free_font_name_p
)
2893 #endif /* HAVE_X_WINDOWS */
2896 /* Merge two Lisp face attribute vectors FROM and TO and store the
2897 resulting attributes in TO. Every non-nil attribute of FROM
2898 overrides the corresponding attribute of TO. */
2901 merge_face_vectors (from
, to
)
2902 Lisp_Object
*from
, *to
;
2905 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2906 if (!UNSPECIFIEDP (from
[i
]))
2911 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
2912 is a face property, determine the resulting face attributes on
2913 frame F, and store them in TO. PROP may be a single face
2914 specification or a list of such specifications. Each face
2915 specification can be
2917 1. A symbol or string naming a Lisp face.
2919 2. A property list of the form (KEYWORD VALUE ...) where each
2920 KEYWORD is a face attribute name, and value is an appropriate value
2923 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2924 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2925 for compatibility with 20.2.
2927 Face specifications earlier in lists take precedence over later
2931 merge_face_vector_with_property (f
, to
, prop
)
2938 Lisp_Object first
= XCAR (prop
);
2940 if (EQ (first
, Qforeground_color
)
2941 || EQ (first
, Qbackground_color
))
2943 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2944 . COLOR). COLOR must be a string. */
2945 Lisp_Object color_name
= XCDR (prop
);
2946 Lisp_Object color
= first
;
2948 if (STRINGP (color_name
))
2950 if (EQ (color
, Qforeground_color
))
2951 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2953 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2956 add_to_log ("Invalid face color", color_name
, Qnil
);
2958 else if (SYMBOLP (first
)
2959 && *XSYMBOL (first
)->name
->data
== ':')
2961 /* Assume this is the property list form. */
2962 while (CONSP (prop
) && CONSP (XCDR (prop
)))
2964 Lisp_Object keyword
= XCAR (prop
);
2965 Lisp_Object value
= XCAR (XCDR (prop
));
2967 if (EQ (keyword
, QCfamily
))
2969 if (STRINGP (value
))
2970 to
[LFACE_FAMILY_INDEX
] = value
;
2972 add_to_log ("Illegal face font family", value
, Qnil
);
2974 else if (EQ (keyword
, QCheight
))
2976 if (INTEGERP (value
))
2977 to
[LFACE_HEIGHT_INDEX
] = value
;
2979 add_to_log ("Illegal face font height", value
, Qnil
);
2981 else if (EQ (keyword
, QCweight
))
2984 && face_numeric_weight (value
) >= 0)
2985 to
[LFACE_WEIGHT_INDEX
] = value
;
2987 add_to_log ("Illegal face weight", value
, Qnil
);
2989 else if (EQ (keyword
, QCslant
))
2992 && face_numeric_slant (value
) >= 0)
2993 to
[LFACE_SLANT_INDEX
] = value
;
2995 add_to_log ("Illegal face slant", value
, Qnil
);
2997 else if (EQ (keyword
, QCunderline
))
3002 to
[LFACE_UNDERLINE_INDEX
] = value
;
3004 add_to_log ("Illegal face underline", value
, Qnil
);
3006 else if (EQ (keyword
, QCoverline
))
3011 to
[LFACE_OVERLINE_INDEX
] = value
;
3013 add_to_log ("Illegal face overline", value
, Qnil
);
3015 else if (EQ (keyword
, QCstrike_through
))
3020 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3022 add_to_log ("Illegal face strike-through", value
, Qnil
);
3024 else if (EQ (keyword
, QCbox
))
3027 value
= make_number (1);
3028 if (INTEGERP (value
)
3032 to
[LFACE_BOX_INDEX
] = value
;
3034 add_to_log ("Illegal face box", value
, Qnil
);
3036 else if (EQ (keyword
, QCinverse_video
)
3037 || EQ (keyword
, QCreverse_video
))
3039 if (EQ (value
, Qt
) || NILP (value
))
3040 to
[LFACE_INVERSE_INDEX
] = value
;
3042 add_to_log ("Illegal face inverse-video", value
, Qnil
);
3044 else if (EQ (keyword
, QCforeground
))
3046 if (STRINGP (value
))
3047 to
[LFACE_FOREGROUND_INDEX
] = value
;
3049 add_to_log ("Illegal face foreground", value
, Qnil
);
3051 else if (EQ (keyword
, QCbackground
))
3053 if (STRINGP (value
))
3054 to
[LFACE_BACKGROUND_INDEX
] = value
;
3056 add_to_log ("Illegal face background", value
, Qnil
);
3058 else if (EQ (keyword
, QCstipple
))
3060 #ifdef HAVE_X_WINDOWS
3061 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3062 if (!NILP (pixmap_p
))
3063 to
[LFACE_STIPPLE_INDEX
] = value
;
3065 add_to_log ("Illegal face stipple", value
, Qnil
);
3068 else if (EQ (keyword
, QCwidth
))
3071 && face_numeric_swidth (value
) >= 0)
3072 to
[LFACE_SWIDTH_INDEX
] = value
;
3074 add_to_log ("Illegal face width", value
, Qnil
);
3077 add_to_log ("Invalid attribute %s in face property",
3080 prop
= XCDR (XCDR (prop
));
3085 /* This is a list of face specs. Specifications at the
3086 beginning of the list take precedence over later
3087 specifications, so we have to merge starting with the
3088 last specification. */
3089 Lisp_Object next
= XCDR (prop
);
3091 merge_face_vector_with_property (f
, to
, next
);
3092 merge_face_vector_with_property (f
, to
, first
);
3097 /* PROP ought to be a face name. */
3098 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3100 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3102 merge_face_vectors (XVECTOR (lface
)->contents
, to
);
3107 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3108 Sinternal_make_lisp_face
, 1, 2, 0,
3109 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3110 If FACE was not known as a face before, create a new one.\n\
3111 If optional argument FRAME is specified, make a frame-local face\n\
3112 for that frame. Otherwise operate on the global face definition.\n\
3113 Value is a vector of face attributes.")
3115 Lisp_Object face
, frame
;
3117 Lisp_Object global_lface
, lface
;
3121 CHECK_SYMBOL (face
, 0);
3122 global_lface
= lface_from_face_name (NULL
, face
, 0);
3126 CHECK_LIVE_FRAME (frame
, 1);
3128 lface
= lface_from_face_name (f
, face
, 0);
3131 f
= NULL
, lface
= Qnil
;
3133 /* Add a global definition if there is none. */
3134 if (NILP (global_lface
))
3136 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3138 XVECTOR (global_lface
)->contents
[0] = Qface
;
3139 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3140 Vface_new_frame_defaults
);
3142 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3143 face id to Lisp face is given by the vector lface_id_to_name.
3144 The mapping from Lisp face to Lisp face id is given by the
3145 property `face' of the Lisp face name. */
3146 if (next_lface_id
== lface_id_to_name_size
)
3148 int new_size
= max (50, 2 * lface_id_to_name_size
);
3149 int sz
= new_size
* sizeof *lface_id_to_name
;
3150 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3151 lface_id_to_name_size
= new_size
;
3154 lface_id_to_name
[next_lface_id
] = face
;
3155 Fput (face
, Qface
, make_number (next_lface_id
));
3159 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3160 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3162 /* Add a frame-local definition. */
3167 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3169 XVECTOR (lface
)->contents
[0] = Qface
;
3170 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3173 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3174 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3177 lface
= global_lface
;
3179 xassert (LFACEP (lface
));
3180 check_lface (lface
);
3185 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3186 Sinternal_lisp_face_p
, 1, 2, 0,
3187 "Return non-nil if FACE names a face.\n\
3188 If optional second parameter FRAME is non-nil, check for the\n\
3189 existence of a frame-local face with name FACE on that frame.\n\
3190 Otherwise check for the existence of a global face.")
3192 Lisp_Object face
, frame
;
3198 CHECK_LIVE_FRAME (frame
, 1);
3199 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3202 lface
= lface_from_face_name (NULL
, face
, 0);
3208 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3209 Sinternal_copy_lisp_face
, 4, 4, 0,
3210 "Copy face FROM to TO.\n\
3211 If FRAME it t, copy the global face definition of FROM to the\n\
3212 global face definition of TO. Otherwise, copy the frame-local\n\
3213 definition of FROM on FRAME to the frame-local definition of TO\n\
3214 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3217 (from
, to
, frame
, new_frame
)
3218 Lisp_Object from
, to
, frame
, new_frame
;
3220 Lisp_Object lface
, copy
;
3222 CHECK_SYMBOL (from
, 0);
3223 CHECK_SYMBOL (to
, 1);
3224 if (NILP (new_frame
))
3229 /* Copy global definition of FROM. We don't make copies of
3230 strings etc. because 20.2 didn't do it either. */
3231 lface
= lface_from_face_name (NULL
, from
, 1);
3232 copy
= Finternal_make_lisp_face (to
, Qnil
);
3236 /* Copy frame-local definition of FROM. */
3237 CHECK_LIVE_FRAME (frame
, 2);
3238 CHECK_LIVE_FRAME (new_frame
, 3);
3239 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3240 copy
= Finternal_make_lisp_face (to
, new_frame
);
3243 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3244 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3250 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3251 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3252 "Set attribute ATTR of FACE to VALUE.\n\
3253 If optional argument FRAME is given, set the face attribute of face FACE\n\
3254 on that frame. If FRAME is t, set the attribute of the default for face\n\
3255 FACE (for new frames). If FRAME is omitted or nil, use the selected\n\
3257 (face
, attr
, value
, frame
)
3258 Lisp_Object face
, attr
, value
, frame
;
3261 Lisp_Object old_value
= Qnil
;
3262 int font_related_attr_p
= 0;
3264 CHECK_SYMBOL (face
, 0);
3265 CHECK_SYMBOL (attr
, 1);
3267 face
= resolve_face_name (face
);
3269 /* Set lface to the Lisp attribute vector of FACE. */
3271 lface
= lface_from_face_name (NULL
, face
, 1);
3275 frame
= selected_frame
;
3277 CHECK_LIVE_FRAME (frame
, 3);
3278 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3280 /* If a frame-local face doesn't exist yet, create one. */
3282 lface
= Finternal_make_lisp_face (face
, frame
);
3285 if (EQ (attr
, QCfamily
))
3287 if (!UNSPECIFIEDP (value
))
3289 CHECK_STRING (value
, 3);
3290 if (XSTRING (value
)->size
== 0)
3291 signal_error ("Invalid face family", value
);
3293 old_value
= LFACE_FAMILY (lface
);
3294 LFACE_FAMILY (lface
) = value
;
3295 font_related_attr_p
= 1;
3297 else if (EQ (attr
, QCheight
))
3299 if (!UNSPECIFIEDP (value
))
3301 CHECK_NUMBER (value
, 3);
3302 if (XINT (value
) <= 0)
3303 signal_error ("Invalid face height", value
);
3305 old_value
= LFACE_HEIGHT (lface
);
3306 LFACE_HEIGHT (lface
) = value
;
3307 font_related_attr_p
= 1;
3309 else if (EQ (attr
, QCweight
))
3311 if (!UNSPECIFIEDP (value
))
3313 CHECK_SYMBOL (value
, 3);
3314 if (face_numeric_weight (value
) < 0)
3315 signal_error ("Invalid face weight", value
);
3317 old_value
= LFACE_WEIGHT (lface
);
3318 LFACE_WEIGHT (lface
) = value
;
3319 font_related_attr_p
= 1;
3321 else if (EQ (attr
, QCslant
))
3323 if (!UNSPECIFIEDP (value
))
3325 CHECK_SYMBOL (value
, 3);
3326 if (face_numeric_slant (value
) < 0)
3327 signal_error ("Invalid face slant", value
);
3329 old_value
= LFACE_SLANT (lface
);
3330 LFACE_SLANT (lface
) = value
;
3331 font_related_attr_p
= 1;
3333 else if (EQ (attr
, QCunderline
))
3335 if (!UNSPECIFIEDP (value
))
3336 if ((SYMBOLP (value
)
3338 && !EQ (value
, Qnil
))
3339 /* Underline color. */
3341 && XSTRING (value
)->size
== 0))
3342 signal_error ("Invalid face underline", value
);
3344 old_value
= LFACE_UNDERLINE (lface
);
3345 LFACE_UNDERLINE (lface
) = value
;
3347 else if (EQ (attr
, QCoverline
))
3349 if (!UNSPECIFIEDP (value
))
3350 if ((SYMBOLP (value
)
3352 && !EQ (value
, Qnil
))
3353 /* Overline color. */
3355 && XSTRING (value
)->size
== 0))
3356 signal_error ("Invalid face overline", value
);
3358 old_value
= LFACE_OVERLINE (lface
);
3359 LFACE_OVERLINE (lface
) = value
;
3361 else if (EQ (attr
, QCstrike_through
))
3363 if (!UNSPECIFIEDP (value
))
3364 if ((SYMBOLP (value
)
3366 && !EQ (value
, Qnil
))
3367 /* Strike-through color. */
3369 && XSTRING (value
)->size
== 0))
3370 signal_error ("Invalid face strike-through", value
);
3372 old_value
= LFACE_STRIKE_THROUGH (lface
);
3373 LFACE_STRIKE_THROUGH (lface
) = value
;
3375 else if (EQ (attr
, QCbox
))
3379 /* Allow t meaning a simple box of width 1 in foreground color
3382 value
= make_number (1);
3384 if (UNSPECIFIEDP (value
))
3386 else if (NILP (value
))
3388 else if (INTEGERP (value
))
3389 valid_p
= XINT (value
) > 0;
3390 else if (STRINGP (value
))
3391 valid_p
= XSTRING (value
)->size
> 0;
3392 else if (CONSP (value
))
3408 if (EQ (k
, QCline_width
))
3410 if (!INTEGERP (v
) || XINT (v
) <= 0)
3413 else if (EQ (k
, QCcolor
))
3415 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3418 else if (EQ (k
, QCstyle
))
3420 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3427 valid_p
= NILP (tem
);
3433 signal_error ("Invalid face box", value
);
3435 old_value
= LFACE_BOX (lface
);
3436 LFACE_BOX (lface
) = value
;
3438 else if (EQ (attr
, QCinverse_video
)
3439 || EQ (attr
, QCreverse_video
))
3441 if (!UNSPECIFIEDP (value
))
3443 CHECK_SYMBOL (value
, 3);
3444 if (!EQ (value
, Qt
) && !NILP (value
))
3445 signal_error ("Invalid inverse-video face attribute value", value
);
3447 old_value
= LFACE_INVERSE (lface
);
3448 LFACE_INVERSE (lface
) = value
;
3450 else if (EQ (attr
, QCforeground
))
3452 if (!UNSPECIFIEDP (value
))
3454 /* Don't check for valid color names here because it depends
3455 on the frame (display) whether the color will be valid
3456 when the face is realized. */
3457 CHECK_STRING (value
, 3);
3458 if (XSTRING (value
)->size
== 0)
3459 signal_error ("Empty foreground color value", value
);
3461 old_value
= LFACE_FOREGROUND (lface
);
3462 LFACE_FOREGROUND (lface
) = value
;
3464 else if (EQ (attr
, QCbackground
))
3466 if (!UNSPECIFIEDP (value
))
3468 /* Don't check for valid color names here because it depends
3469 on the frame (display) whether the color will be valid
3470 when the face is realized. */
3471 CHECK_STRING (value
, 3);
3472 if (XSTRING (value
)->size
== 0)
3473 signal_error ("Empty background color value", value
);
3475 old_value
= LFACE_BACKGROUND (lface
);
3476 LFACE_BACKGROUND (lface
) = value
;
3478 else if (EQ (attr
, QCstipple
))
3480 #ifdef HAVE_X_WINDOWS
3481 if (!UNSPECIFIEDP (value
)
3483 && NILP (Fbitmap_spec_p (value
)))
3484 signal_error ("Invalid stipple attribute", value
);
3485 old_value
= LFACE_STIPPLE (lface
);
3486 LFACE_STIPPLE (lface
) = value
;
3487 #endif /* HAVE_X_WINDOWS */
3489 else if (EQ (attr
, QCwidth
))
3491 if (!UNSPECIFIEDP (value
))
3493 CHECK_SYMBOL (value
, 3);
3494 if (face_numeric_swidth (value
) < 0)
3495 signal_error ("Invalid face width", value
);
3497 old_value
= LFACE_SWIDTH (lface
);
3498 LFACE_SWIDTH (lface
) = value
;
3499 font_related_attr_p
= 1;
3501 else if (EQ (attr
, QCfont
))
3503 #ifdef HAVE_X_WINDOWS
3504 /* Set font-related attributes of the Lisp face from an
3508 CHECK_STRING (value
, 3);
3510 f
= SELECTED_FRAME ();
3512 f
= check_x_frame (frame
);
3514 if (!set_lface_from_font_name (f
, lface
, XSTRING (value
)->data
, 1, 1))
3515 signal_error ("Invalid font name", value
);
3517 font_related_attr_p
= 1;
3518 #endif /* HAVE_X_WINDOWS */
3520 else if (EQ (attr
, QCbold
))
3522 old_value
= LFACE_WEIGHT (lface
);
3523 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3524 font_related_attr_p
= 1;
3526 else if (EQ (attr
, QCitalic
))
3528 old_value
= LFACE_SLANT (lface
);
3529 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3530 font_related_attr_p
= 1;
3533 signal_error ("Invalid face attribute name", attr
);
3535 /* Changing a named face means that all realized faces depending on
3536 that face are invalid. Since we cannot tell which realized faces
3537 depend on the face, make sure they are all removed. This is done
3538 by incrementing face_change_count. The next call to
3539 init_iterator will then free realized faces. */
3541 && (EQ (attr
, QCfont
)
3542 || NILP (Fequal (old_value
, value
))))
3544 ++face_change_count
;
3545 ++windows_or_buffers_changed
;
3548 #ifdef HAVE_X_WINDOWS
3551 && !UNSPECIFIEDP (value
)
3552 && NILP (Fequal (old_value
, value
)))
3558 if (EQ (face
, Qdefault
))
3560 /* Changed font-related attributes of the `default' face are
3561 reflected in changed `font' frame parameters. */
3562 if (font_related_attr_p
3563 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3564 set_font_frame_param (frame
, lface
);
3565 else if (EQ (attr
, QCforeground
))
3566 param
= Qforeground_color
;
3567 else if (EQ (attr
, QCbackground
))
3568 param
= Qbackground_color
;
3570 else if (EQ (face
, Qscroll_bar
))
3572 /* Changing the colors of `scroll-bar' sets frame parameters
3573 `scroll-bar-foreground' and `scroll-bar-background'. */
3574 if (EQ (attr
, QCforeground
))
3575 param
= Qscroll_bar_foreground
;
3576 else if (EQ (attr
, QCbackground
))
3577 param
= Qscroll_bar_background
;
3579 else if (EQ (face
, Qborder
))
3581 /* Changing background color of `border' sets frame parameter
3583 if (EQ (attr
, QCbackground
))
3584 param
= Qborder_color
;
3586 else if (EQ (face
, Qcursor
))
3588 /* Changing background color of `cursor' sets frame parameter
3590 if (EQ (attr
, QCbackground
))
3591 param
= Qcursor_color
;
3593 else if (EQ (face
, Qmouse
))
3595 /* Changing background color of `mouse' sets frame parameter
3597 if (EQ (attr
, QCbackground
))
3598 param
= Qmouse_color
;
3601 if (SYMBOLP (param
))
3602 Fmodify_frame_parameters (frame
, Fcons (Fcons (param
, value
), Qnil
));
3605 #endif /* HAVE_X_WINDOWS */
3611 #ifdef HAVE_X_WINDOWS
3613 /* Set the `font' frame parameter of FRAME according to `default' face
3614 attributes LFACE. */
3617 set_font_frame_param (frame
, lface
)
3618 Lisp_Object frame
, lface
;
3620 struct frame
*f
= XFRAME (frame
);
3621 Lisp_Object frame_font
;
3625 /* Get FRAME's font parameter. */
3626 frame_font
= Fassq (Qfont
, f
->param_alist
);
3627 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
3628 frame_font
= XCDR (frame_font
);
3630 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
3633 /* Frame parameter is a fontset name. Modify the fontset so
3634 that all its fonts reflect face attributes LFACE. */
3636 struct fontset_info
*fontset_info
;
3638 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3640 for (charset
= 0; charset
< MAX_CHARSET
; ++charset
)
3641 if (fontset_info
->fontname
[charset
])
3643 font
= choose_face_fontset_font (f
, XVECTOR (lface
)->contents
,
3645 Fset_fontset_font (frame_font
, CHARSET_SYMBOL (charset
),
3646 build_string (font
), frame
);
3652 /* Frame parameter is an X font name. I believe this can
3653 only happen in unibyte mode. */
3654 font
= choose_face_font (f
, XVECTOR (lface
)->contents
,
3655 -1, Vface_default_registry
);
3658 store_frame_param (f
, Qfont
, build_string (font
));
3665 /* Update the corresponding face when frame parameter PARAM on frame F
3666 has been assigned the value NEW_VALUE. */
3669 update_face_from_frame_parameter (f
, param
, new_value
)
3671 Lisp_Object param
, new_value
;
3675 /* If there are no faces yet, give up. This is the case when called
3676 from Fx_create_frame, and we do the necessary things later in
3677 face-set-after-frame-defaults. */
3678 if (NILP (f
->face_alist
))
3681 if (EQ (param
, Qforeground_color
))
3683 lface
= lface_from_face_name (f
, Qdefault
, 1);
3684 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3685 ? new_value
: Qunspecified
);
3686 realize_basic_faces (f
);
3688 else if (EQ (param
, Qbackground_color
))
3692 /* Changing the background color might change the background
3693 mode, so that we have to load new defface specs. Call
3694 frame-update-face-colors to do that. */
3695 XSETFRAME (frame
, f
);
3696 call1 (Qframe_update_face_colors
, frame
);
3698 lface
= lface_from_face_name (f
, Qdefault
, 1);
3699 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3700 ? new_value
: Qunspecified
);
3701 realize_basic_faces (f
);
3703 if (EQ (param
, Qborder_color
))
3705 lface
= lface_from_face_name (f
, Qborder
, 1);
3706 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3707 ? new_value
: Qunspecified
);
3709 else if (EQ (param
, Qcursor_color
))
3711 lface
= lface_from_face_name (f
, Qcursor
, 1);
3712 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3713 ? new_value
: Qunspecified
);
3715 else if (EQ (param
, Qmouse_color
))
3717 lface
= lface_from_face_name (f
, Qmouse
, 1);
3718 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3719 ? new_value
: Qunspecified
);
3724 /* Get the value of X resource RESOURCE, class CLASS for the display
3725 of frame FRAME. This is here because ordinary `x-get-resource'
3726 doesn't take a frame argument. */
3728 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3729 Sinternal_face_x_get_resource
, 3, 3, 0, "")
3730 (resource
, class, frame
)
3731 Lisp_Object resource
, class, frame
;
3734 CHECK_STRING (resource
, 0);
3735 CHECK_STRING (class, 1);
3736 CHECK_LIVE_FRAME (frame
, 2);
3738 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3739 resource
, class, Qnil
, Qnil
);
3745 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3746 If VALUE is "on" or "true", return t. If VALUE is "off" or
3747 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3748 error; if SIGNAL_P is zero, return 0. */
3751 face_boolean_x_resource_value (value
, signal_p
)
3755 Lisp_Object result
= make_number (0);
3757 xassert (STRINGP (value
));
3759 if (xstricmp (XSTRING (value
)->data
, "on") == 0
3760 || xstricmp (XSTRING (value
)->data
, "true") == 0)
3762 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
3763 || xstricmp (XSTRING (value
)->data
, "false") == 0)
3765 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3766 result
= Qunspecified
;
3768 signal_error ("Invalid face attribute value from X resource", value
);
3774 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3775 Finternal_set_lisp_face_attribute_from_resource
,
3776 Sinternal_set_lisp_face_attribute_from_resource
,
3778 (face
, attr
, value
, frame
)
3779 Lisp_Object face
, attr
, value
, frame
;
3781 CHECK_SYMBOL (face
, 0);
3782 CHECK_SYMBOL (attr
, 1);
3783 CHECK_STRING (value
, 2);
3785 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
3786 value
= Qunspecified
;
3787 else if (EQ (attr
, QCheight
))
3789 value
= Fstring_to_number (value
, make_number (10));
3790 if (XINT (value
) <= 0)
3791 signal_error ("Invalid face height from X resource", value
);
3793 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3794 value
= face_boolean_x_resource_value (value
, 1);
3795 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3796 value
= intern (XSTRING (value
)->data
);
3797 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3798 value
= face_boolean_x_resource_value (value
, 1);
3799 else if (EQ (attr
, QCunderline
)
3800 || EQ (attr
, QCoverline
)
3801 || EQ (attr
, QCstrike_through
)
3802 || EQ (attr
, QCbox
))
3804 Lisp_Object boolean_value
;
3806 /* If the result of face_boolean_x_resource_value is t or nil,
3807 VALUE does NOT specify a color. */
3808 boolean_value
= face_boolean_x_resource_value (value
, 0);
3809 if (SYMBOLP (boolean_value
))
3810 value
= boolean_value
;
3813 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3818 /***********************************************************************
3820 ***********************************************************************/
3822 #ifdef USE_X_TOOLKIT
3824 /* Structure used to pass X resources to functions called via
3825 XtApplyToWidgets. */
3836 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
3837 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3840 /* Set widget W's X resources from P which points to an x_resources
3841 structure. If W is a cascade button, apply resources to W's
3845 xm_apply_resources (w
, p
)
3850 struct x_resources
*res
= (struct x_resources
*) p
;
3852 XtSetValues (w
, res
->av
, res
->ac
);
3853 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
3856 XtSetValues (submenu
, res
->av
, res
->ac
);
3857 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
3862 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
3863 This is the LessTif/Motif version. As of LessTif 0.88 it has the
3866 1. Setting the XmNfontList resource leads to an infinite loop
3867 somewhere in LessTif. */
3870 xm_set_menu_resources_from_menu_face (f
, widget
)
3880 lface
= lface_from_face_name (f
, Qmenu
, 1);
3881 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3883 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3885 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
3889 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3891 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
3895 /* If any font-related attribute of `menu' is set, set the font. */
3897 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3898 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3899 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3900 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3901 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3903 #if 0 /* Setting the font leads to an infinite loop somewhere
3904 in LessTif during geometry computation. */
3906 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
3907 fl
= XmFontListAppendEntry (NULL
, fe
);
3908 XtSetArg (av
[ac
], XmNfontList
, fl
);
3913 xassert (ac
<= sizeof av
/ sizeof *av
);
3917 struct x_resources res
;
3919 XtSetValues (widget
, av
, ac
);
3920 res
.av
= av
, res
.ac
= ac
;
3921 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
3923 XmFontListFree (fl
);
3928 #endif /* USE_MOTIF */
3932 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
3933 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
3936 /* Set widget W's resources from P which points to an x_resources
3940 xl_apply_resources (widget
, p
)
3944 struct x_resources
*res
= (struct x_resources
*) p
;
3945 XtSetValues (widget
, res
->av
, res
->ac
);
3949 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
3950 This is the Lucid version. */
3953 xl_set_menu_resources_from_menu_face (f
, widget
)
3962 lface
= lface_from_face_name (f
, Qmenu
, 1);
3963 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3965 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
3967 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
3971 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
3973 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
3978 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3979 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3980 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3981 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3982 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3984 XtSetArg (av
[ac
], XtNfont
, face
->font
);
3990 struct x_resources res
;
3992 XtSetValues (widget
, av
, ac
);
3994 /* We must do children here in case we're handling a pop-up menu
3995 in which case WIDGET is a popup shell. XtApplyToWidgets
3996 is a function from lwlib. */
3997 res
.av
= av
, res
.ac
= ac
;
3998 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4002 #endif /* USE_LUCID */
4005 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4008 x_set_menu_resources_from_menu_face (f
, widget
)
4012 /* Realized faces may have been removed on frame F, e.g. because of
4013 face attribute changes. Recompute them, if necessary, since we
4014 will need the `menu' face. */
4015 if (f
->face_cache
->used
== 0)
4016 recompute_basic_faces (f
);
4019 xl_set_menu_resources_from_menu_face (f
, widget
);
4022 xm_set_menu_resources_from_menu_face (f
, widget
);
4026 #endif /* USE_X_TOOLKIT */
4028 #endif /* HAVE_X_WINDOWS */
4032 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4033 Sinternal_get_lisp_face_attribute
,
4035 "Return face attribute KEYWORD of face SYMBOL.\n\
4036 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4037 face attribute name, signal an error.\n\
4038 If the optional argument FRAME is given, report on face FACE in that\n\
4039 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4040 frames). If FRAME is omitted or nil, use the selected frame.")
4041 (symbol
, keyword
, frame
)
4042 Lisp_Object symbol
, keyword
, frame
;
4044 Lisp_Object lface
, value
= Qnil
;
4046 CHECK_SYMBOL (symbol
, 0);
4047 CHECK_SYMBOL (keyword
, 1);
4050 lface
= lface_from_face_name (NULL
, symbol
, 1);
4054 frame
= selected_frame
;
4055 CHECK_LIVE_FRAME (frame
, 2);
4056 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4059 if (EQ (keyword
, QCfamily
))
4060 value
= LFACE_FAMILY (lface
);
4061 else if (EQ (keyword
, QCheight
))
4062 value
= LFACE_HEIGHT (lface
);
4063 else if (EQ (keyword
, QCweight
))
4064 value
= LFACE_WEIGHT (lface
);
4065 else if (EQ (keyword
, QCslant
))
4066 value
= LFACE_SLANT (lface
);
4067 else if (EQ (keyword
, QCunderline
))
4068 value
= LFACE_UNDERLINE (lface
);
4069 else if (EQ (keyword
, QCoverline
))
4070 value
= LFACE_OVERLINE (lface
);
4071 else if (EQ (keyword
, QCstrike_through
))
4072 value
= LFACE_STRIKE_THROUGH (lface
);
4073 else if (EQ (keyword
, QCbox
))
4074 value
= LFACE_BOX (lface
);
4075 else if (EQ (keyword
, QCinverse_video
)
4076 || EQ (keyword
, QCreverse_video
))
4077 value
= LFACE_INVERSE (lface
);
4078 else if (EQ (keyword
, QCforeground
))
4079 value
= LFACE_FOREGROUND (lface
);
4080 else if (EQ (keyword
, QCbackground
))
4081 value
= LFACE_BACKGROUND (lface
);
4082 else if (EQ (keyword
, QCstipple
))
4083 value
= LFACE_STIPPLE (lface
);
4084 else if (EQ (keyword
, QCwidth
))
4085 value
= LFACE_SWIDTH (lface
);
4087 signal_error ("Invalid face attribute name", keyword
);
4093 DEFUN ("internal-lisp-face-attribute-values",
4094 Finternal_lisp_face_attribute_values
,
4095 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4096 "Return a list of valid discrete values for face attribute ATTR.\n\
4097 Value is nil if ATTR doesn't have a discrete set of valid values.")
4101 Lisp_Object result
= Qnil
;
4103 CHECK_SYMBOL (attr
, 0);
4105 if (EQ (attr
, QCweight
)
4106 || EQ (attr
, QCslant
)
4107 || EQ (attr
, QCwidth
))
4109 /* Extract permissible symbols from tables. */
4110 struct table_entry
*table
;
4113 if (EQ (attr
, QCweight
))
4114 table
= weight_table
, dim
= DIM (weight_table
);
4115 else if (EQ (attr
, QCslant
))
4116 table
= slant_table
, dim
= DIM (slant_table
);
4118 table
= swidth_table
, dim
= DIM (swidth_table
);
4120 for (i
= 0; i
< dim
; ++i
)
4122 Lisp_Object symbol
= *table
[i
].symbol
;
4123 Lisp_Object tail
= result
;
4126 && !EQ (XCAR (tail
), symbol
))
4130 result
= Fcons (symbol
, result
);
4133 else if (EQ (attr
, QCunderline
))
4134 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4135 else if (EQ (attr
, QCoverline
))
4136 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4137 else if (EQ (attr
, QCstrike_through
))
4138 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4139 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4140 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4146 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4147 Sinternal_merge_in_global_face
, 2, 2, 0,
4148 "Add attributes from frame-default definition of FACE to FACE on FRAME.")
4150 Lisp_Object face
, frame
;
4152 Lisp_Object global_lface
, local_lface
;
4153 CHECK_LIVE_FRAME (frame
, 1);
4154 global_lface
= lface_from_face_name (NULL
, face
, 1);
4155 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4156 if (NILP (local_lface
))
4157 local_lface
= Finternal_make_lisp_face (face
, frame
);
4158 merge_face_vectors (XVECTOR (global_lface
)->contents
,
4159 XVECTOR (local_lface
)->contents
);
4164 /* The following function is implemented for compatibility with 20.2.
4165 The function is used in x-resolve-fonts when it is asked to
4166 return fonts with the same size as the font of a face. This is
4167 done in fontset.el. */
4169 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4170 "Return the font name of face FACE, or nil if it is unspecified.\n\
4171 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4172 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4173 The font default for a face is either nil, or a list\n\
4174 of the form (bold), (italic) or (bold italic).\n\
4175 If FRAME is omitted or nil, use the selected frame.")
4177 Lisp_Object face
, frame
;
4181 Lisp_Object result
= Qnil
;
4182 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4184 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4185 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4186 result
= Fcons (Qbold
, result
);
4188 if (!NILP (LFACE_SLANT (lface
))
4189 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4190 result
= Fcons (Qitalic
, result
);
4196 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4197 int face_id
= lookup_named_face (f
, face
, CHARSET_ASCII
);
4198 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4199 return build_string (face
->font_name
);
4204 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4205 all attributes are `equal'. Tries to be fast because this function
4206 is called quite often. */
4209 lface_equal_p (v1
, v2
)
4210 Lisp_Object
*v1
, *v2
;
4214 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4216 Lisp_Object a
= v1
[i
];
4217 Lisp_Object b
= v2
[i
];
4219 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4220 and the other is specified. */
4221 equal_p
= XTYPE (a
) == XTYPE (b
);
4230 equal_p
= (XSTRING (a
)->size
== XSTRING (b
)->size
4231 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4232 XSTRING (a
)->size
) == 0);
4241 equal_p
= !NILP (Fequal (a
, b
));
4251 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4252 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4253 "True if FACE1 and FACE2 are equal.\n\
4254 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4255 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4256 If FRAME is omitted or nil, use the selected frame.")
4257 (face1
, face2
, frame
)
4258 Lisp_Object face1
, face2
, frame
;
4262 Lisp_Object lface1
, lface2
;
4267 /* Don't use check_x_frame here because this function is called
4268 before X frames exist. At that time, if FRAME is nil,
4269 selected_frame will be used which is the frame dumped with
4270 Emacs. That frame is not an X frame. */
4271 f
= frame_or_selected_frame (frame
, 2);
4273 lface1
= lface_from_face_name (NULL
, face1
, 1);
4274 lface2
= lface_from_face_name (NULL
, face2
, 1);
4275 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4276 XVECTOR (lface2
)->contents
);
4277 return equal_p
? Qt
: Qnil
;
4281 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4282 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4283 "True if FACE has no attribute specified.\n\
4284 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4285 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4286 If FRAME is omitted or nil, use the selected frame.")
4288 Lisp_Object face
, frame
;
4295 frame
= selected_frame
;
4296 CHECK_LIVE_FRAME (frame
, 0);
4300 lface
= lface_from_face_name (NULL
, face
, 1);
4302 lface
= lface_from_face_name (f
, face
, 1);
4304 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4305 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4308 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4312 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4314 "Return an alist of frame-local faces defined on FRAME.\n\
4315 For internal use only.")
4319 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4320 return f
->face_alist
;
4324 /* Return a hash code for Lisp string STRING with case ignored. Used
4325 below in computing a hash value for a Lisp face. */
4327 static INLINE
unsigned
4328 hash_string_case_insensitive (string
)
4333 xassert (STRINGP (string
));
4334 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4335 hash
= (hash
<< 1) ^ tolower (*s
);
4340 /* Return a hash code for face attribute vector V. */
4342 static INLINE
unsigned
4346 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4347 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4348 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4349 ^ (unsigned) v
[LFACE_WEIGHT_INDEX
]
4350 ^ (unsigned) v
[LFACE_SLANT_INDEX
]
4351 ^ (unsigned) v
[LFACE_SWIDTH_INDEX
]
4352 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4356 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4357 considering charsets/registries). They do if they specify the same
4358 family, point size, weight, width and slant. Both LFACE1 and
4359 LFACE2 must be fully-specified. */
4362 lface_same_font_attributes_p (lface1
, lface2
)
4363 Lisp_Object
*lface1
, *lface2
;
4365 xassert (lface_fully_specified_p (lface1
)
4366 && lface_fully_specified_p (lface2
));
4367 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4368 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4369 && (XFASTINT (lface1
[LFACE_HEIGHT_INDEX
])
4370 == XFASTINT (lface2
[LFACE_HEIGHT_INDEX
]))
4371 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4372 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4373 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
]));
4378 /***********************************************************************
4380 ***********************************************************************/
4382 /* Allocate and return a new realized face for Lisp face attribute
4383 vector ATTR, charset CHARSET, and registry REGISTRY. */
4385 static struct face
*
4386 make_realized_face (attr
, charset
, registry
)
4389 Lisp_Object registry
;
4391 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4392 bzero (face
, sizeof *face
);
4393 face
->charset
= charset
;
4394 face
->registry
= registry
;
4395 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4400 /* Free realized face FACE, including its X resources. FACE may
4404 free_realized_face (f
, face
)
4410 #ifdef HAVE_X_WINDOWS
4415 x_free_gc (f
, face
->gc
);
4419 free_face_colors (f
, face
);
4420 x_destroy_bitmap (f
, face
->stipple
);
4422 #endif /* HAVE_X_WINDOWS */
4429 /* Prepare face FACE for subsequent display on frame F. This
4430 allocated GCs if they haven't been allocated yet or have been freed
4431 by clearing the face cache. */
4434 prepare_face_for_display (f
, face
)
4438 #ifdef HAVE_X_WINDOWS
4439 xassert (FRAME_X_P (f
));
4444 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4446 xgcv
.foreground
= face
->foreground
;
4447 xgcv
.background
= face
->background
;
4448 xgcv
.graphics_exposures
= False
;
4450 /* The font of FACE may be null if we couldn't load it. */
4453 xgcv
.font
= face
->font
->fid
;
4460 xgcv
.fill_style
= FillOpaqueStippled
;
4461 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4462 mask
|= GCFillStyle
| GCStipple
;
4465 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4472 /* Non-zero if FACE is suitable for displaying ISO8859-1. Used in
4473 macro FACE_SUITABLE_FOR_CHARSET_P to avoid realizing a new face for
4474 ISO8859-1 if the ASCII face suffices. */
4477 face_suitable_for_iso8859_1_p (face
)
4480 int len
= strlen (face
->font_name
);
4481 return len
>= 9 && xstricmp (face
->font_name
+ len
- 9, "iso8859-1") == 0;
4485 /* Value is non-zero if FACE is suitable for displaying characters
4486 of CHARSET. CHARSET < 0 means unibyte text. */
4489 face_suitable_for_charset_p (face
, charset
)
4497 if (EQ (face
->registry
, Vface_default_registry
)
4498 || !NILP (Fequal (face
->registry
, Vface_default_registry
)))
4501 else if (face
->charset
== charset
)
4503 else if (face
->charset
== CHARSET_ASCII
4504 && charset
== charset_latin_iso8859_1
)
4505 suitable_p
= face_suitable_for_iso8859_1_p (face
);
4506 else if (face
->charset
== charset_latin_iso8859_1
4507 && charset
== CHARSET_ASCII
)
4515 /***********************************************************************
4517 ***********************************************************************/
4519 /* Return a new face cache for frame F. */
4521 static struct face_cache
*
4525 struct face_cache
*c
;
4528 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4529 bzero (c
, sizeof *c
);
4530 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4531 c
->buckets
= (struct face
**) xmalloc (size
);
4532 bzero (c
->buckets
, size
);
4534 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4540 /* Clear out all graphics contexts for all realized faces, except for
4541 the basic faces. This should be done from time to time just to avoid
4542 keeping too many graphics contexts that are no longer needed. */
4546 struct face_cache
*c
;
4548 if (c
&& FRAME_X_P (c
->f
))
4550 #ifdef HAVE_X_WINDOWS
4552 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4554 struct face
*face
= c
->faces_by_id
[i
];
4555 if (face
&& face
->gc
)
4557 x_free_gc (c
->f
, face
->gc
);
4561 #endif /* HAVE_X_WINDOWS */
4566 /* Free all realized faces in face cache C, including basic faces. C
4567 may be null. If faces are freed, make sure the frame's current
4568 matrix is marked invalid, so that a display caused by an expose
4569 event doesn't try to use faces we destroyed. */
4572 free_realized_faces (c
)
4573 struct face_cache
*c
;
4578 struct frame
*f
= c
->f
;
4580 for (i
= 0; i
< c
->used
; ++i
)
4582 free_realized_face (f
, c
->faces_by_id
[i
]);
4583 c
->faces_by_id
[i
] = NULL
;
4587 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4588 bzero (c
->buckets
, size
);
4590 /* Must do a thorough redisplay the next time. Mark current
4591 matrices as invalid because they will reference faces freed
4592 above. This function is also called when a frame is
4593 destroyed. In this case, the root window of F is nil. */
4594 if (WINDOWP (f
->root_window
))
4596 clear_current_matrices (f
);
4597 ++windows_or_buffers_changed
;
4603 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4604 This is done after attributes of a named face have been changed,
4605 because we can't tell which realized faces depend on that face. */
4608 free_all_realized_faces (frame
)
4614 FOR_EACH_FRAME (rest
, frame
)
4615 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4618 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4622 /* Free face cache C and faces in it, including their X resources. */
4626 struct face_cache
*c
;
4630 free_realized_faces (c
);
4632 xfree (c
->faces_by_id
);
4638 /* Cache realized face FACE in face cache C. HASH is the hash value
4639 of FACE. If FACE->fontset >= 0, add the new face to the end of the
4640 collision list of the face hash table of C. This is done because
4641 otherwise lookup_face would find FACE for every charset, even if
4642 faces with the same attributes but for specific charsets exist. */
4645 cache_face (c
, face
, hash
)
4646 struct face_cache
*c
;
4650 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4654 if (face
->fontset
>= 0)
4656 struct face
*last
= c
->buckets
[i
];
4667 c
->buckets
[i
] = face
;
4668 face
->prev
= face
->next
= NULL
;
4674 face
->next
= c
->buckets
[i
];
4676 face
->next
->prev
= face
;
4677 c
->buckets
[i
] = face
;
4680 /* Find a free slot in C->faces_by_id and use the index of the free
4681 slot as FACE->id. */
4682 for (i
= 0; i
< c
->used
; ++i
)
4683 if (c
->faces_by_id
[i
] == NULL
)
4687 /* Maybe enlarge C->faces_by_id. */
4688 if (i
== c
->used
&& c
->used
== c
->size
)
4690 int new_size
= 2 * c
->size
;
4691 int sz
= new_size
* sizeof *c
->faces_by_id
;
4692 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4697 /* Check that FACE got a unique id. */
4702 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4703 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4709 #endif /* GLYPH_DEBUG */
4711 c
->faces_by_id
[i
] = face
;
4717 /* Remove face FACE from cache C. */
4720 uncache_face (c
, face
)
4721 struct face_cache
*c
;
4724 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4727 face
->prev
->next
= face
->next
;
4729 c
->buckets
[i
] = face
->next
;
4732 face
->next
->prev
= face
->prev
;
4734 c
->faces_by_id
[face
->id
] = NULL
;
4735 if (face
->id
== c
->used
)
4740 /* Look up a realized face with face attributes ATTR in the face cache
4741 of frame F. The face will be used to display characters of
4742 CHARSET. CHARSET < 0 means the face will be used to display
4743 unibyte text. The value of face-default-registry is used to choose
4744 a font for the face in that case. Value is the ID of the face
4745 found. If no suitable face is found, realize a new one. */
4748 lookup_face (f
, attr
, charset
)
4753 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
4758 xassert (c
!= NULL
);
4759 check_lface_attrs (attr
);
4761 /* Look up ATTR in the face cache. */
4762 hash
= lface_hash (attr
);
4763 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4765 for (face
= c
->buckets
[i
]; face
; face
= face
->next
)
4766 if (face
->hash
== hash
4767 && (!FRAME_WINDOW_P (f
)
4768 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
))
4769 && lface_equal_p (face
->lface
, attr
))
4772 /* If not found, realize a new face. */
4775 face
= realize_face (c
, attr
, charset
);
4776 cache_face (c
, face
, hash
);
4780 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4782 xassert (charset
< 0 || FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
4783 #endif /* GLYPH_DEBUG */
4789 /* Return the face id of the realized face for named face SYMBOL on
4790 frame F suitable for displaying characters from CHARSET. CHARSET <
4791 0 means unibyte text. */
4794 lookup_named_face (f
, symbol
, charset
)
4799 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4800 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4801 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4803 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4804 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4805 merge_face_vectors (symbol_attrs
, attrs
);
4806 return lookup_face (f
, attrs
, charset
);
4810 /* Return the ID of the realized ASCII face of Lisp face with ID
4811 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4814 ascii_face_of_lisp_face (f
, lface_id
)
4820 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4822 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4823 face_id
= lookup_named_face (f
, face_name
, CHARSET_ASCII
);
4832 /* Return a face for charset ASCII that is like the face with id
4833 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4834 STEPS < 0 means larger. Value is the id of the face. */
4837 smaller_face (f
, face_id
, steps
)
4841 #ifdef HAVE_X_WINDOWS
4843 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4844 int pt
, last_pt
, last_height
;
4847 struct face
*new_face
;
4849 /* If not called for an X frame, just return the original face. */
4850 if (FRAME_TERMCAP_P (f
))
4853 /* Try in increments of 1/2 pt. */
4854 delta
= steps
< 0 ? 5 : -5;
4855 steps
= abs (steps
);
4857 face
= FACE_FROM_ID (f
, face_id
);
4858 bcopy (face
->lface
, attrs
, sizeof attrs
);
4859 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4860 new_face_id
= face_id
;
4861 last_height
= FONT_HEIGHT (face
->font
);
4865 /* Give up if we cannot find a font within 10pt. */
4866 && abs (last_pt
- pt
) < 100)
4868 /* Look up a face for a slightly smaller/larger font. */
4870 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4871 new_face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4872 new_face
= FACE_FROM_ID (f
, new_face_id
);
4874 /* If height changes, count that as one step. */
4875 if (FONT_HEIGHT (new_face
->font
) != last_height
)
4878 last_height
= FONT_HEIGHT (new_face
->font
);
4885 #else /* not HAVE_X_WINDOWS */
4889 #endif /* not HAVE_X_WINDOWS */
4893 /* Return a face for charset ASCII that is like the face with id
4894 FACE_ID on frame F, but has height HEIGHT. */
4897 face_with_height (f
, face_id
, height
)
4902 #ifdef HAVE_X_WINDOWS
4904 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4906 if (FRAME_TERMCAP_P (f
)
4910 face
= FACE_FROM_ID (f
, face_id
);
4911 bcopy (face
->lface
, attrs
, sizeof attrs
);
4912 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4913 face_id
= lookup_face (f
, attrs
, CHARSET_ASCII
);
4914 #endif /* HAVE_X_WINDOWS */
4919 /* Return the face id of the realized face for named face SYMBOL on
4920 frame F suitable for displaying characters from CHARSET (CHARSET <
4921 0 means unibyte text), and use attributes of the face FACE_ID for
4922 attributes that aren't completely specified by SYMBOL. This is
4923 like lookup_named_face, except that the default attributes come
4924 from FACE_ID, not from the default face. FACE_ID is assumed to
4925 be already realized. */
4928 lookup_derived_face (f
, symbol
, charset
, face_id
)
4934 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4935 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4936 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4941 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
4942 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4943 merge_face_vectors (symbol_attrs
, attrs
);
4944 return lookup_face (f
, attrs
, charset
);
4949 /***********************************************************************
4951 ***********************************************************************/
4953 DEFUN ("internal-set-font-selection-order",
4954 Finternal_set_font_selection_order
,
4955 Sinternal_set_font_selection_order
, 1, 1, 0,
4956 "Set font selection order for face font selection to ORDER.\n\
4957 ORDER must be a list of length 4 containing the symbols `:width',\n\
4958 `:height', `:weight', and `:slant'. Face attributes appearing\n\
4959 first in ORDER are matched first, e.g. if `:height' appears before\n\
4960 `:weight' in ORDER, font selection first tries to find a font with\n\
4961 a suitable height, and then tries to match the font weight.\n\
4970 CHECK_LIST (order
, 0);
4971 bzero (indices
, sizeof indices
);
4975 CONSP (list
) && i
< DIM (indices
);
4976 list
= XCDR (list
), ++i
)
4978 Lisp_Object attr
= XCAR (list
);
4981 if (EQ (attr
, QCwidth
))
4983 else if (EQ (attr
, QCheight
))
4984 xlfd
= XLFD_POINT_SIZE
;
4985 else if (EQ (attr
, QCweight
))
4987 else if (EQ (attr
, QCslant
))
4992 if (indices
[i
] != 0)
4998 || i
!= DIM (indices
)
5003 signal_error ("Invalid font sort order", order
);
5005 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5007 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5008 free_all_realized_faces (Qnil
);
5015 DEFUN ("internal-set-alternative-font-family-alist",
5016 Finternal_set_alternative_font_family_alist
,
5017 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5018 "Define alternative font families to try in face font selection.\n\
5019 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5020 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5021 be found. Value is ALIST.")
5025 CHECK_LIST (alist
, 0);
5026 Vface_alternative_font_family_alist
= alist
;
5027 free_all_realized_faces (Qnil
);
5032 #ifdef HAVE_X_WINDOWS
5034 /* Return the X registry and encoding of font name FONT_NAME on frame F.
5035 Value is nil if not successful. */
5038 deduce_unibyte_registry (f
, font_name
)
5042 struct font_name font
;
5043 Lisp_Object registry
= Qnil
;
5045 font
.name
= STRDUPA (font_name
);
5046 if (split_font_name (f
, &font
, 0))
5050 /* Extract registry and encoding. */
5051 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_REGISTRY
])
5052 + strlen (font
.fields
[XLFD_ENCODING
])
5054 strcpy (buffer
, font
.fields
[XLFD_REGISTRY
]);
5055 strcat (buffer
, "-");
5056 strcat (buffer
, font
.fields
[XLFD_ENCODING
]);
5057 registry
= build_string (buffer
);
5064 /* Value is non-zero if FONT is the name of a scalable font. The
5065 X11R6 XLFD spec says that point size, pixel size, and average width
5066 are zero for scalable fonts. Intlfonts contain at least one
5067 scalable font ("*-muleindian-1") for which this isn't true, so we
5068 just test average width. */
5071 font_scalable_p (font
)
5072 struct font_name
*font
;
5074 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5075 return *s
== '0' && *(s
+ 1) == '\0';
5079 /* Value is non-zero if FONT1 is a better match for font attributes
5080 VALUES than FONT2. VALUES is an array of face attribute values in
5081 font sort order. COMPARE_PT_P zero means don't compare point
5085 better_font_p (values
, font1
, font2
, compare_pt_p
)
5087 struct font_name
*font1
, *font2
;
5092 for (i
= 0; i
< 4; ++i
)
5094 int xlfd_idx
= font_sort_order
[i
];
5096 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5098 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5099 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5101 if (delta1
> delta2
)
5103 else if (delta1
< delta2
)
5107 /* The difference may be equal because, e.g., the face
5108 specifies `italic' but we have only `regular' and
5109 `oblique'. Prefer `oblique' in this case. */
5110 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5111 && font1
->numeric
[xlfd_idx
] > values
[i
]
5112 && font2
->numeric
[xlfd_idx
] < values
[i
])
5124 /* Value is non-zero if FONT is an exact match for face attributes in
5125 SPECIFIED. SPECIFIED is an array of face attribute values in font
5129 exact_face_match_p (specified
, font
)
5131 struct font_name
*font
;
5135 for (i
= 0; i
< 4; ++i
)
5136 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5143 /* Value is the name of a scaled font, generated from scalable font
5144 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5145 Value is allocated from heap. */
5148 build_scalable_font_name (f
, font
, specified_pt
)
5150 struct font_name
*font
;
5153 char point_size
[20], pixel_size
[20];
5155 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5158 /* If scalable font is for a specific resolution, compute
5159 the point size we must specify from the resolution of
5160 the display and the specified resolution of the font. */
5161 if (font
->numeric
[XLFD_RESY
] != 0)
5163 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5164 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5169 pixel_value
= resy
/ 720.0 * pt
;
5172 /* Set point size of the font. */
5173 sprintf (point_size
, "%d", (int) pt
);
5174 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5175 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5177 /* Set pixel size. */
5178 sprintf (pixel_size
, "%d", pixel_value
);
5179 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5180 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5182 /* If font doesn't specify its resolution, use the
5183 resolution of the display. */
5184 if (font
->numeric
[XLFD_RESY
] == 0)
5187 sprintf (buffer
, "%d", (int) resy
);
5188 font
->fields
[XLFD_RESY
] = buffer
;
5189 font
->numeric
[XLFD_RESY
] = resy
;
5192 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5195 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5196 sprintf (buffer
, "%d", resx
);
5197 font
->fields
[XLFD_RESX
] = buffer
;
5198 font
->numeric
[XLFD_RESX
] = resx
;
5201 return build_font_name (font
);
5205 /* Value is non-zero if we are allowed to use scalable font FONT. We
5206 can't run a Lisp function here since this function may be called
5207 with input blocked. */
5210 may_use_scalable_font_p (font
, name
)
5211 struct font_name
*font
;
5214 if (EQ (Vscalable_fonts_allowed
, Qt
))
5216 else if (CONSP (Vscalable_fonts_allowed
))
5218 Lisp_Object tail
, regexp
;
5220 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5222 regexp
= XCAR (tail
);
5223 if (STRINGP (regexp
)
5224 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5232 #endif /* SCALABLE_FONTS != 0 */
5235 /* Return the name of the best matching font for face attributes
5236 ATTRS in the array of font_name structures FONTS which contains
5237 NFONTS elements. Value is a font name which is allocated from
5238 the heap. FONTS is freed by this function. */
5241 best_matching_font (f
, attrs
, fonts
, nfonts
)
5244 struct font_name
*fonts
;
5248 struct font_name
*best
;
5256 /* Make specified font attributes available in `specified',
5257 indexed by sort order. */
5258 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5260 int xlfd_idx
= font_sort_order
[i
];
5262 if (xlfd_idx
== XLFD_SWIDTH
)
5263 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5264 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5265 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5266 else if (xlfd_idx
== XLFD_WEIGHT
)
5267 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5268 else if (xlfd_idx
== XLFD_SLANT
)
5269 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5279 /* Start with the first non-scalable font in the list. */
5280 for (i
= 0; i
< nfonts
; ++i
)
5281 if (!font_scalable_p (fonts
+ i
))
5284 /* Find the best match among the non-scalable fonts. */
5289 for (i
= 1; i
< nfonts
; ++i
)
5290 if (!font_scalable_p (fonts
+ i
)
5291 && better_font_p (specified
, fonts
+ i
, best
, 1))
5295 exact_p
= exact_face_match_p (specified
, best
);
5304 /* Unless we found an exact match among non-scalable fonts, see if
5305 we can find a better match among scalable fonts. */
5308 /* A scalable font is better if
5310 1. its weight, slant, swidth attributes are better, or.
5312 2. the best non-scalable font doesn't have the required
5313 point size, and the scalable fonts weight, slant, swidth
5316 int non_scalable_has_exact_height_p
;
5318 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5319 non_scalable_has_exact_height_p
= 1;
5321 non_scalable_has_exact_height_p
= 0;
5323 for (i
= 0; i
< nfonts
; ++i
)
5324 if (font_scalable_p (fonts
+ i
))
5327 || better_font_p (specified
, fonts
+ i
, best
, 0)
5328 || (!non_scalable_has_exact_height_p
5329 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5334 if (font_scalable_p (best
))
5335 font_name
= build_scalable_font_name (f
, best
, pt
);
5337 font_name
= build_font_name (best
);
5339 #else /* !SCALABLE_FONTS */
5341 /* Find the best non-scalable font. */
5344 for (i
= 1; i
< nfonts
; ++i
)
5346 xassert (!font_scalable_p (fonts
+ i
));
5347 if (better_font_p (specified
, fonts
+ i
, best
, 1))
5351 font_name
= build_font_name (best
);
5353 #endif /* !SCALABLE_FONTS */
5355 /* Free font_name structures. */
5356 free_font_names (fonts
, nfonts
);
5362 /* Try to get a list of fonts on frame F with font family FAMILY and
5363 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5364 of font_name structures for the fonts matched. Value is the number
5368 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5371 char *pattern
, *family
, *registry
;
5372 struct font_name
**fonts
;
5377 family
= LSTRDUPA (attrs
[LFACE_FAMILY_INDEX
]);
5379 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5385 /* Try alternative font families from
5386 Vface_alternative_font_family_alist. */
5387 alter
= Fassoc (build_string (family
),
5388 Vface_alternative_font_family_alist
);
5390 for (alter
= XCDR (alter
);
5391 CONSP (alter
) && nfonts
== 0;
5392 alter
= XCDR (alter
))
5394 if (STRINGP (XCAR (alter
)))
5396 family
= LSTRDUPA (XCAR (alter
));
5397 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5401 /* Try font family of the default face or "fixed". */
5404 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5406 family
= LSTRDUPA (dflt
->lface
[LFACE_FAMILY_INDEX
]);
5409 nfonts
= font_list (f
, NULL
, family
, registry
, fonts
);
5412 /* Try any family with the given registry. */
5414 nfonts
= font_list (f
, NULL
, "*", registry
, fonts
);
5421 /* Return the registry and encoding pattern that fonts for CHARSET
5422 should match. Value is allocated from the heap. */
5425 x_charset_registry (charset
)
5428 Lisp_Object prop
, charset_plist
;
5431 /* Get registry and encoding from the charset's plist. */
5432 charset_plist
= CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
);
5433 prop
= Fplist_get (charset_plist
, Qx_charset_registry
);
5437 if (index (XSTRING (prop
)->data
, '-'))
5438 registry
= xstrdup (XSTRING (prop
)->data
);
5441 /* If registry doesn't contain a `-', make it a pattern. */
5442 registry
= (char *) xmalloc (STRING_BYTES (XSTRING (prop
)) + 5);
5443 strcpy (registry
, XSTRING (prop
)->data
);
5444 strcat (registry
, "*-*");
5447 else if (STRINGP (Vface_default_registry
))
5448 registry
= xstrdup (XSTRING (Vface_default_registry
)->data
);
5450 registry
= xstrdup ("iso8859-1");
5456 /* Return the fontset id of the fontset name or alias name given by
5457 the family attribute of ATTRS on frame F. Value is -1 if the
5458 family attribute of ATTRS doesn't name a fontset. */
5461 face_fontset (f
, attrs
)
5465 Lisp_Object name
= attrs
[LFACE_FAMILY_INDEX
];
5468 name
= Fquery_fontset (name
, Qnil
);
5472 fontset
= fs_query_fontset (f
, XSTRING (name
)->data
);
5478 /* Get the font to use for the face realizing the fully-specified Lisp
5479 face ATTRS for charset CHARSET on frame F. CHARSET < 0 means
5480 unibyte text; UNIBYTE_REGISTRY is the registry and encoding to use
5481 in this case. Value is the font name which is allocated from the
5482 heap (which means that it must be freed eventually). */
5485 choose_face_font (f
, attrs
, charset
, unibyte_registry
)
5489 Lisp_Object unibyte_registry
;
5491 struct font_name
*fonts
;
5495 /* ATTRS must be fully-specified. */
5496 xassert (lface_fully_specified_p (attrs
));
5498 if (STRINGP (unibyte_registry
))
5499 registry
= xstrdup (XSTRING (unibyte_registry
)->data
);
5501 registry
= x_charset_registry (charset
);
5503 nfonts
= try_font_list (f
, attrs
, NULL
, NULL
, registry
, &fonts
);
5505 return best_matching_font (f
, attrs
, fonts
, nfonts
);
5509 /* Choose a font to use on frame F to display CHARSET using FONTSET
5510 with Lisp face attributes specified by ATTRS. CHARSET may be any
5511 valid charset. CHARSET < 0 means unibyte text. If the fontset
5512 doesn't contain a font pattern for charset, use the pattern for
5513 CHARSET_ASCII. Value is the font name which is allocated from the
5514 heap and must be freed by the caller. */
5517 choose_face_fontset_font (f
, attrs
, fontset
, charset
)
5520 int fontset
, charset
;
5523 char *font_name
= NULL
;
5524 struct fontset_info
*fontset_info
;
5525 struct font_name
*fonts
;
5528 xassert (fontset
>= 0 && fontset
< FRAME_FONTSET_DATA (f
)->n_fontsets
);
5530 /* For unibyte text, use the ASCII font of the fontset. Using the
5531 ASCII font seems to be the most reasonable thing we can do in
5534 charset
= CHARSET_ASCII
;
5536 /* Get the font name pattern to use for CHARSET from the fontset. */
5537 fontset_info
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
5538 pattern
= fontset_info
->fontname
[charset
];
5540 pattern
= fontset_info
->fontname
[CHARSET_ASCII
];
5543 /* Get a list of fonts matching that pattern and choose the
5544 best match for the specified face attributes from it. */
5545 nfonts
= try_font_list (f
, attrs
, pattern
, NULL
, NULL
, &fonts
);
5546 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5550 #endif /* HAVE_X_WINDOWS */
5554 /***********************************************************************
5556 ***********************************************************************/
5558 /* Realize basic faces on frame F. Value is zero if frame parameters
5559 of F don't contain enough information needed to realize the default
5563 realize_basic_faces (f
)
5568 if (realize_default_face (f
))
5570 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5571 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5572 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5573 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5574 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5575 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5576 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5577 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5578 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5586 /* Realize the default face on frame F. If the face is not fully
5587 specified, make it fully-specified. Attributes of the default face
5588 that are not explicitly specified are taken from frame parameters. */
5591 realize_default_face (f
)
5594 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5596 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5597 Lisp_Object unibyte_registry
;
5598 Lisp_Object frame_font
;
5602 /* If the `default' face is not yet known, create it. */
5603 lface
= lface_from_face_name (f
, Qdefault
, 0);
5607 XSETFRAME (frame
, f
);
5608 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5611 #ifdef HAVE_X_WINDOWS
5614 /* Set frame_font to the value of the `font' frame parameter. */
5615 frame_font
= Fassq (Qfont
, f
->param_alist
);
5616 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5617 frame_font
= XCDR (frame_font
);
5619 fontset
= fs_query_fontset (f
, XSTRING (frame_font
)->data
);
5622 /* If frame_font is a fontset name, don't use that for
5623 determining font-related attributes of the default face
5624 because it is just an artificial name. Use the ASCII font of
5625 the fontset, instead. */
5626 struct font_info
*font_info
;
5627 struct font_name font
;
5630 font_info
= FS_LOAD_FONT (f
, FRAME_X_FONT_TABLE (f
), CHARSET_ASCII
,
5634 /* Set weight etc. from the ASCII font. */
5635 if (!set_lface_from_font_name (f
, lface
, font_info
->full_name
, 0, 0))
5638 /* Remember registry and encoding of the frame font. */
5639 unibyte_registry
= deduce_unibyte_registry (f
, font_info
->full_name
);
5640 if (STRINGP (unibyte_registry
))
5641 Vface_default_registry
= unibyte_registry
;
5643 Vface_default_registry
= build_string ("iso8859-1");
5645 /* But set the family to the fontset alias name. Implementation
5646 note: When a font is passed to Emacs via `-fn FONT', a
5647 fontset is created in `x-win.el' whose name ends in
5648 `fontset-startup'. This fontset has an alias name that is
5649 equal to frame_font. */
5650 xassert (STRINGP (frame_font
));
5651 font
.name
= LSTRDUPA (frame_font
);
5653 if (!split_font_name (f
, &font
, 1)
5654 || xstricmp (font
.fields
[XLFD_REGISTRY
], "fontset") != 0
5655 || xstricmp (font
.fields
[XLFD_ENCODING
], "startup") != 0)
5656 LFACE_FAMILY (lface
) = frame_font
;
5660 /* Frame parameters contain a real font. Fill default face
5661 attributes from that font. */
5662 if (!set_lface_from_font_name (f
, lface
,
5663 XSTRING (frame_font
)->data
, 0, 0))
5666 /* Remember registry and encoding of the frame font. */
5668 = deduce_unibyte_registry (f
, XSTRING (frame_font
)->data
);
5669 if (STRINGP (unibyte_registry
))
5670 Vface_default_registry
= unibyte_registry
;
5672 Vface_default_registry
= build_string ("iso8859-1");
5675 #endif /* HAVE_X_WINDOWS */
5677 if (!FRAME_WINDOW_P (f
))
5679 LFACE_FAMILY (lface
) = build_string ("default");
5680 LFACE_SWIDTH (lface
) = Qnormal
;
5681 LFACE_HEIGHT (lface
) = make_number (1);
5682 LFACE_WEIGHT (lface
) = Qnormal
;
5683 LFACE_SLANT (lface
) = Qnormal
;
5686 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5687 LFACE_UNDERLINE (lface
) = Qnil
;
5689 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5690 LFACE_OVERLINE (lface
) = Qnil
;
5692 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5693 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5695 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5696 LFACE_BOX (lface
) = Qnil
;
5698 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5699 LFACE_INVERSE (lface
) = Qnil
;
5701 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5703 /* This function is called so early that colors are not yet
5704 set in the frame parameter list. */
5705 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5707 if (CONSP (color
) && STRINGP (XCDR (color
)))
5708 LFACE_FOREGROUND (lface
) = XCDR (color
);
5709 else if (FRAME_X_P (f
))
5711 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5712 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5717 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5719 /* This function is called so early that colors are not yet
5720 set in the frame parameter list. */
5721 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5722 if (CONSP (color
) && STRINGP (XCDR (color
)))
5723 LFACE_BACKGROUND (lface
) = XCDR (color
);
5724 else if (FRAME_X_P (f
))
5726 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5727 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5732 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5733 LFACE_STIPPLE (lface
) = Qnil
;
5735 /* Realize the face; it must be fully-specified now. */
5736 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5737 check_lface (lface
);
5738 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5739 face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5741 /* Remove the former default face. */
5742 if (c
->used
> DEFAULT_FACE_ID
)
5744 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5745 uncache_face (c
, default_face
);
5746 free_realized_face (f
, default_face
);
5749 /* Insert the new default face. */
5750 cache_face (c
, face
, lface_hash (attrs
));
5751 xassert (face
->id
== DEFAULT_FACE_ID
);
5756 /* Realize basic faces other than the default face in face cache C.
5757 SYMBOL is the face name, ID is the face id the realized face must
5758 have. The default face must have been realized already. */
5761 realize_named_face (f
, symbol
, id
)
5766 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5767 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5768 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5769 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5770 struct face
*new_face
;
5772 /* The default face must exist and be fully specified. */
5773 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5774 check_lface_attrs (attrs
);
5775 xassert (lface_fully_specified_p (attrs
));
5777 /* If SYMBOL isn't know as a face, create it. */
5781 XSETFRAME (frame
, f
);
5782 lface
= Finternal_make_lisp_face (symbol
, frame
);
5785 /* Merge SYMBOL's face with the default face. */
5786 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5787 merge_face_vectors (symbol_attrs
, attrs
);
5789 /* Realize the face. */
5790 new_face
= realize_face (c
, attrs
, CHARSET_ASCII
);
5792 /* Remove the former face. */
5795 struct face
*old_face
= c
->faces_by_id
[id
];
5796 uncache_face (c
, old_face
);
5797 free_realized_face (f
, old_face
);
5800 /* Insert the new face. */
5801 cache_face (c
, new_face
, lface_hash (attrs
));
5802 xassert (new_face
->id
== id
);
5806 /* Realize the fully-specified face with attributes ATTRS in face
5807 cache C for character set CHARSET or for unibyte text if CHARSET <
5808 0. Value is a pointer to the newly created realized face. */
5810 static struct face
*
5811 realize_face (c
, attrs
, charset
)
5812 struct face_cache
*c
;
5818 /* LFACE must be fully specified. */
5819 xassert (c
!= NULL
);
5820 check_lface_attrs (attrs
);
5822 if (FRAME_X_P (c
->f
))
5823 face
= realize_x_face (c
, attrs
, charset
);
5824 else if (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
))
5825 face
= realize_tty_face (c
, attrs
, charset
);
5833 /* Realize the fully-specified face with attributes ATTRS in face
5834 cache C for character set CHARSET or for unibyte text if CHARSET <
5835 0. Do it for X frame C->f. Value is a pointer to the newly
5836 created realized face. */
5838 static struct face
*
5839 realize_x_face (c
, attrs
, charset
)
5840 struct face_cache
*c
;
5844 #ifdef HAVE_X_WINDOWS
5845 struct face
*face
, *default_face
;
5847 Lisp_Object stipple
, overline
, strike_through
, box
;
5848 Lisp_Object unibyte_registry
;
5849 struct gcpro gcpro1
;
5851 xassert (FRAME_X_P (c
->f
));
5853 /* If realizing a face for use in unibyte text, get the X registry
5854 and encoding to use from Vface_default_registry. */
5856 unibyte_registry
= (STRINGP (Vface_default_registry
)
5857 ? Vface_default_registry
5858 : build_string ("iso8859-1"));
5860 unibyte_registry
= Qnil
;
5861 GCPRO1 (unibyte_registry
);
5863 /* Allocate a new realized face. */
5864 face
= make_realized_face (attrs
, charset
, unibyte_registry
);
5867 /* Determine the font to use. Most of the time, the font will be
5868 the same as the font of the default face, so try that first. */
5869 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5871 && FACE_SUITABLE_FOR_CHARSET_P (default_face
, charset
)
5872 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5874 face
->font
= default_face
->font
;
5875 face
->fontset
= default_face
->fontset
;
5876 face
->font_info_id
= default_face
->font_info_id
;
5877 face
->font_name
= default_face
->font_name
;
5878 face
->registry
= default_face
->registry
;
5880 else if (charset
>= 0)
5882 /* For all charsets, we use our own font selection functions to
5883 choose a best matching font for the specified face
5884 attributes. If the face specifies a fontset alias name, the
5885 fontset determines the font name pattern, otherwise we
5886 construct a font pattern from face attributes and charset. */
5888 char *font_name
= NULL
;
5889 int fontset
= face_fontset (f
, attrs
);
5892 font_name
= choose_face_font (f
, attrs
, charset
, Qnil
);
5895 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5899 load_face_font_or_fontset (f
, face
, font_name
, fontset
);
5904 /* Unibyte case, and font is not equal to that of the default
5905 face. UNIBYTE_REGISTRY is the X registry and encoding the
5906 font should have. What is a reasonable thing to do if the
5907 user specified a fontset alias name for the face in this
5908 case? We choose a font by taking the ASCII font of the
5909 fontset, but using UNIBYTE_REGISTRY for its registry and
5912 char *font_name
= NULL
;
5913 int fontset
= face_fontset (f
, attrs
);
5916 font_name
= choose_face_font (f
, attrs
, charset
, unibyte_registry
);
5918 font_name
= choose_face_fontset_font (f
, attrs
, fontset
, charset
);
5920 load_face_font_or_fontset (f
, face
, font_name
, -1);
5924 /* Load colors, and set remaining attributes. */
5926 load_face_colors (f
, face
, attrs
);
5929 box
= attrs
[LFACE_BOX_INDEX
];
5932 /* A simple box of line width 1 drawn in color given by
5934 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5936 face
->box
= FACE_SIMPLE_BOX
;
5937 face
->box_line_width
= 1;
5939 else if (INTEGERP (box
))
5941 /* Simple box of specified line width in foreground color of the
5943 xassert (XINT (box
) > 0);
5944 face
->box
= FACE_SIMPLE_BOX
;
5945 face
->box_line_width
= XFASTINT (box
);
5946 face
->box_color
= face
->foreground
;
5947 face
->box_color_defaulted_p
= 1;
5949 else if (CONSP (box
))
5951 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5952 being one of `raised' or `sunken'. */
5953 face
->box
= FACE_SIMPLE_BOX
;
5954 face
->box_color
= face
->foreground
;
5955 face
->box_color_defaulted_p
= 1;
5956 face
->box_line_width
= 1;
5960 Lisp_Object keyword
, value
;
5962 keyword
= XCAR (box
);
5970 if (EQ (keyword
, QCline_width
))
5972 if (INTEGERP (value
) && XINT (value
) > 0)
5973 face
->box_line_width
= XFASTINT (value
);
5975 else if (EQ (keyword
, QCcolor
))
5977 if (STRINGP (value
))
5979 face
->box_color
= load_color (f
, face
, value
,
5981 face
->use_box_color_for_shadows_p
= 1;
5984 else if (EQ (keyword
, QCstyle
))
5986 if (EQ (value
, Qreleased_button
))
5987 face
->box
= FACE_RAISED_BOX
;
5988 else if (EQ (value
, Qpressed_button
))
5989 face
->box
= FACE_SUNKEN_BOX
;
5994 /* Text underline, overline, strike-through. */
5996 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5998 /* Use default color (same as foreground color). */
5999 face
->underline_p
= 1;
6000 face
->underline_defaulted_p
= 1;
6001 face
->underline_color
= 0;
6003 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6005 /* Use specified color. */
6006 face
->underline_p
= 1;
6007 face
->underline_defaulted_p
= 0;
6008 face
->underline_color
6009 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6010 LFACE_UNDERLINE_INDEX
);
6012 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6014 face
->underline_p
= 0;
6015 face
->underline_defaulted_p
= 0;
6016 face
->underline_color
= 0;
6019 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6020 if (STRINGP (overline
))
6022 face
->overline_color
6023 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6024 LFACE_OVERLINE_INDEX
);
6025 face
->overline_p
= 1;
6027 else if (EQ (overline
, Qt
))
6029 face
->overline_color
= face
->foreground
;
6030 face
->overline_color_defaulted_p
= 1;
6031 face
->overline_p
= 1;
6034 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6035 if (STRINGP (strike_through
))
6037 face
->strike_through_color
6038 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6039 LFACE_STRIKE_THROUGH_INDEX
);
6040 face
->strike_through_p
= 1;
6042 else if (EQ (strike_through
, Qt
))
6044 face
->strike_through_color
= face
->foreground
;
6045 face
->strike_through_color_defaulted_p
= 1;
6046 face
->strike_through_p
= 1;
6049 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6050 if (!NILP (stipple
))
6051 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6054 xassert (face
->fontset
< 0);
6055 xassert (FACE_SUITABLE_FOR_CHARSET_P (face
, charset
));
6057 #endif /* HAVE_X_WINDOWS */
6061 /* Realize the fully-specified face with attributes ATTRS in face
6062 cache C for character set CHARSET or for unibyte text if CHARSET <
6063 0. Do it for TTY frame C->f. Value is a pointer to the newly
6064 created realized face. */
6066 static struct face
*
6067 realize_tty_face (c
, attrs
, charset
)
6068 struct face_cache
*c
;
6075 Lisp_Object tty_defined_color_alist
=
6076 Fsymbol_value (intern ("tty-defined-color-alist"));
6077 Lisp_Object tty_color_alist
= intern ("tty-color-alist");
6079 int face_colors_defaulted
= 0;
6081 /* Frame must be a termcap frame. */
6082 xassert (FRAME_TERMCAP_P (c
->f
) || FRAME_MSDOS_P (c
->f
));
6084 /* Allocate a new realized face. */
6085 face
= make_realized_face (attrs
, charset
, Qnil
);
6086 face
->font_name
= FRAME_MSDOS_P (c
->f
) ? "ms-dos" : "tty";
6088 /* Map face attributes to TTY appearances. We map slant to
6089 dimmed text because we want italic text to appear differently
6090 and because dimmed text is probably used infrequently. */
6091 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6092 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6094 if (weight
> XLFD_WEIGHT_MEDIUM
)
6095 face
->tty_bold_p
= 1;
6096 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6097 face
->tty_dim_p
= 1;
6098 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6099 face
->tty_underline_p
= 1;
6100 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6101 face
->tty_reverse_p
= 1;
6103 /* Map color names to color indices. */
6104 face
->foreground
= FACE_TTY_DEFAULT_FG_COLOR
;
6105 face
->background
= FACE_TTY_DEFAULT_BG_COLOR
;
6107 XSETFRAME (frame
, c
->f
);
6108 color
= attrs
[LFACE_FOREGROUND_INDEX
];
6110 && XSTRING (color
)->size
6111 && !NILP (tty_defined_color_alist
)
6112 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6114 /* Associations in tty-defined-color-alist are of the form
6115 (NAME INDEX R G B). We need the INDEX part. */
6116 face
->foreground
= XINT (XCAR (XCDR (color
)));
6118 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6119 && STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]))
6121 face
->foreground
= load_color (c
->f
, face
,
6122 attrs
[LFACE_FOREGROUND_INDEX
],
6123 LFACE_FOREGROUND_INDEX
);
6125 /* If the foreground of the default face is the default color,
6126 use the foreground color defined by the frame. */
6127 if (FRAME_MSDOS_P (c
->f
))
6129 if (face
->foreground
== FACE_TTY_DEFAULT_FG_COLOR
6130 || face
->foreground
== FACE_TTY_DEFAULT_COLOR
)
6132 face
->foreground
= FRAME_FOREGROUND_PIXEL (f
);
6133 attrs
[LFACE_FOREGROUND_INDEX
] =
6134 msdos_stdcolor_name (face
->foreground
);
6135 face_colors_defaulted
= 1;
6137 else if (face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6139 face
->foreground
= FRAME_BACKGROUND_PIXEL (f
);
6140 attrs
[LFACE_FOREGROUND_INDEX
] =
6141 msdos_stdcolor_name (face
->foreground
);
6142 face_colors_defaulted
= 1;
6148 color
= attrs
[LFACE_BACKGROUND_INDEX
];
6150 && XSTRING (color
)->size
6151 && !NILP (tty_defined_color_alist
)
6152 && (color
= Fassoc (color
, call1 (tty_color_alist
, frame
)),
6154 /* Associations in tty-defined-color-alist are of the form
6155 (NAME INDEX R G B). We need the INDEX part. */
6156 face
->background
= XINT (XCAR (XCDR (color
)));
6158 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6159 && STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]))
6161 face
->background
= load_color (c
->f
, face
,
6162 attrs
[LFACE_BACKGROUND_INDEX
],
6163 LFACE_BACKGROUND_INDEX
);
6165 /* If the background of the default face is the default color,
6166 use the background color defined by the frame. */
6167 if (FRAME_MSDOS_P (c
->f
))
6169 if (face
->background
== FACE_TTY_DEFAULT_BG_COLOR
6170 || face
->background
== FACE_TTY_DEFAULT_COLOR
)
6172 face
->background
= FRAME_BACKGROUND_PIXEL (f
);
6173 attrs
[LFACE_BACKGROUND_INDEX
] =
6174 msdos_stdcolor_name (face
->background
);
6175 face_colors_defaulted
= 1;
6177 else if (face
->background
== FACE_TTY_DEFAULT_FG_COLOR
)
6179 face
->background
= FRAME_FOREGROUND_PIXEL (f
);
6180 attrs
[LFACE_BACKGROUND_INDEX
] =
6181 msdos_stdcolor_name (face
->background
);
6182 face_colors_defaulted
= 1;
6188 /* Swap colors if face is inverse-video. If the colors are taken
6189 from the frame colors, they are already inverted, since the
6190 frame-creation function calls x-handle-reverse-video. */
6191 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6193 unsigned long tem
= face
->foreground
;
6195 face
->foreground
= face
->background
;
6196 face
->background
= tem
;
6204 /***********************************************************************
6206 ***********************************************************************/
6208 /* Return the ID of the face to use to display character CH with face
6209 property PROP on frame F in current_buffer. */
6212 compute_char_face (f
, ch
, prop
)
6218 int charset
= (NILP (current_buffer
->enable_multibyte_characters
)
6220 : CHAR_CHARSET (ch
));
6223 face_id
= FACE_FOR_CHARSET (f
, DEFAULT_FACE_ID
, charset
);
6226 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6227 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6228 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6229 merge_face_vector_with_property (f
, attrs
, prop
);
6230 face_id
= lookup_face (f
, attrs
, charset
);
6237 /* Return the face ID associated with buffer position POS for
6238 displaying ASCII characters. Return in *ENDPTR the position at
6239 which a different face is needed, as far as text properties and
6240 overlays are concerned. W is a window displaying current_buffer.
6242 REGION_BEG, REGION_END delimit the region, so it can be
6245 LIMIT is a position not to scan beyond. That is to limit the time
6246 this function can take.
6248 If MOUSE is non-zero, use the character's mouse-face, not its face.
6250 The face returned is suitable for displaying CHARSET_ASCII if
6251 current_buffer->enable_multibyte_characters is non-nil. Otherwise,
6252 the face is suitable for displaying unibyte text. */
6255 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6256 endptr
, limit
, mouse
)
6259 int region_beg
, region_end
;
6264 struct frame
*f
= XFRAME (w
->frame
);
6265 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6266 Lisp_Object prop
, position
;
6268 Lisp_Object
*overlay_vec
;
6271 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6272 Lisp_Object limit1
, end
;
6273 struct face
*default_face
;
6274 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6276 /* W must display the current buffer. We could write this function
6277 to use the frame and buffer of W, but right now it doesn't. */
6278 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6280 XSETFRAME (frame
, f
);
6281 XSETFASTINT (position
, pos
);
6284 if (pos
< region_beg
&& region_beg
< endpos
)
6285 endpos
= region_beg
;
6287 /* Get the `face' or `mouse_face' text property at POS, and
6288 determine the next position at which the property changes. */
6289 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6290 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6291 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6293 endpos
= XINT (end
);
6295 /* Look at properties from overlays. */
6300 /* First try with room for 40 overlays. */
6302 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6303 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6304 &next_overlay
, NULL
);
6306 /* If there are more than 40, make enough space for all, and try
6308 if (noverlays
> len
)
6311 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6312 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6313 &next_overlay
, NULL
);
6316 if (next_overlay
< endpos
)
6317 endpos
= next_overlay
;
6322 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6324 /* Optimize common cases where we can use the default face. */
6327 && !(pos
>= region_beg
&& pos
< region_end
)
6329 || !FRAME_WINDOW_P (f
)
6330 || FACE_SUITABLE_FOR_CHARSET_P (default_face
, -1)))
6331 return DEFAULT_FACE_ID
;
6333 /* Begin with attributes from the default face. */
6334 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6336 /* Merge in attributes specified via text properties. */
6338 merge_face_vector_with_property (f
, attrs
, prop
);
6340 /* Now merge the overlay data. */
6341 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6342 for (i
= 0; i
< noverlays
; i
++)
6347 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6349 merge_face_vector_with_property (f
, attrs
, prop
);
6351 oend
= OVERLAY_END (overlay_vec
[i
]);
6352 oendpos
= OVERLAY_POSITION (oend
);
6353 if (oendpos
< endpos
)
6357 /* If in the region, merge in the region face. */
6358 if (pos
>= region_beg
&& pos
< region_end
)
6360 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6361 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6363 if (region_end
< endpos
)
6364 endpos
= region_end
;
6369 /* Look up a realized face with the given face attributes,
6370 or realize a new one. Charset is ignored for tty frames. */
6371 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6375 /* Compute the face at character position POS in Lisp string STRING on
6376 window W, for charset CHARSET_ASCII.
6378 If STRING is an overlay string, it comes from position BUFPOS in
6379 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6380 not an overlay string. W must display the current buffer.
6381 REGION_BEG and REGION_END give the start and end positions of the
6382 region; both are -1 if no region is visible. BASE_FACE_ID is the
6383 id of the basic face to merge with. It is usually equal to
6384 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6385 for strings displayed in the mode or top line.
6387 Set *ENDPTR to the next position where to check for faces in
6388 STRING; -1 if the face is constant from POS to the end of the
6391 Value is the id of the face to use. The face returned is suitable
6392 for displaying CHARSET_ASCII if STRING is multibyte. Otherwise,
6393 the face is suitable for displaying unibyte text. */
6396 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6397 region_end
, endptr
, base_face_id
)
6401 int region_beg
, region_end
;
6403 enum face_id base_face_id
;
6405 Lisp_Object prop
, position
, end
, limit
;
6406 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6407 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6408 struct face
*base_face
;
6409 int multibyte_p
= STRING_MULTIBYTE (string
);
6411 /* Get the value of the face property at the current position within
6412 STRING. Value is nil if there is no face property. */
6413 XSETFASTINT (position
, pos
);
6414 prop
= Fget_text_property (position
, Qface
, string
);
6416 /* Get the next position at which to check for faces. Value of end
6417 is nil if face is constant all the way to the end of the string.
6418 Otherwise it is a string position where to check faces next.
6419 Limit is the maximum position up to which to check for property
6420 changes in Fnext_single_property_change. Strings are usually
6421 short, so set the limit to the end of the string. */
6422 XSETFASTINT (limit
, XSTRING (string
)->size
);
6423 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6425 *endptr
= XFASTINT (end
);
6429 base_face
= FACE_FROM_ID (f
, base_face_id
);
6430 xassert (base_face
);
6432 /* Optimize the default case that there is no face property and we
6433 are not in the region. */
6435 && (base_face_id
!= DEFAULT_FACE_ID
6436 /* BUFPOS <= 0 means STRING is not an overlay string, so
6437 that the region doesn't have to be taken into account. */
6439 || bufpos
< region_beg
6440 || bufpos
>= region_end
)
6442 /* We can't realize faces for different charsets differently
6443 if we don't have fonts, so we can stop here if not working
6444 on a window-system frame. */
6445 || !FRAME_WINDOW_P (f
)
6446 || FACE_SUITABLE_FOR_CHARSET_P (base_face
, -1)))
6447 return base_face
->id
;
6449 /* Begin with attributes from the base face. */
6450 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6452 /* Merge in attributes specified via text properties. */
6454 merge_face_vector_with_property (f
, attrs
, prop
);
6456 /* If in the region, merge in the region face. */
6458 && bufpos
>= region_beg
6459 && bufpos
< region_end
)
6461 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6462 merge_face_vectors (XVECTOR (region_face
)->contents
, attrs
);
6465 /* Look up a realized face with the given face attributes,
6466 or realize a new one. */
6467 return lookup_face (f
, attrs
, multibyte_p
? CHARSET_ASCII
: -1);
6472 /***********************************************************************
6474 ***********************************************************************/
6478 /* Print the contents of the realized face FACE to stderr. */
6481 dump_realized_face (face
)
6484 fprintf (stderr
, "ID: %d\n", face
->id
);
6485 #ifdef HAVE_X_WINDOWS
6486 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6488 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6490 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6491 fprintf (stderr
, "background: 0x%lx (%s)\n",
6493 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6494 fprintf (stderr
, "font_name: %s (%s)\n",
6496 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6497 #ifdef HAVE_X_WINDOWS
6498 fprintf (stderr
, "font = %p\n", face
->font
);
6500 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6501 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6502 fprintf (stderr
, "underline: %d (%s)\n",
6504 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6505 fprintf (stderr
, "hash: %d\n", face
->hash
);
6506 fprintf (stderr
, "charset: %d\n", face
->charset
);
6510 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6518 fprintf (stderr
, "font selection order: ");
6519 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6520 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6521 fprintf (stderr
, "\n");
6523 fprintf (stderr
, "alternative fonts: ");
6524 debug_print (Vface_alternative_font_family_alist
);
6525 fprintf (stderr
, "\n");
6527 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6528 Fdump_face (make_number (i
));
6533 CHECK_NUMBER (n
, 0);
6534 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6536 error ("Not a valid face");
6537 dump_realized_face (face
);
6544 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6548 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6549 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6550 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6554 #endif /* GLYPH_DEBUG != 0 */
6558 /***********************************************************************
6560 ***********************************************************************/
6565 Qface
= intern ("face");
6567 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6568 staticpro (&Qbitmap_spec_p
);
6569 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6570 staticpro (&Qframe_update_face_colors
);
6572 /* Lisp face attribute keywords. */
6573 QCfamily
= intern (":family");
6574 staticpro (&QCfamily
);
6575 QCheight
= intern (":height");
6576 staticpro (&QCheight
);
6577 QCweight
= intern (":weight");
6578 staticpro (&QCweight
);
6579 QCslant
= intern (":slant");
6580 staticpro (&QCslant
);
6581 QCunderline
= intern (":underline");
6582 staticpro (&QCunderline
);
6583 QCinverse_video
= intern (":inverse-video");
6584 staticpro (&QCinverse_video
);
6585 QCreverse_video
= intern (":reverse-video");
6586 staticpro (&QCreverse_video
);
6587 QCforeground
= intern (":foreground");
6588 staticpro (&QCforeground
);
6589 QCbackground
= intern (":background");
6590 staticpro (&QCbackground
);
6591 QCstipple
= intern (":stipple");;
6592 staticpro (&QCstipple
);
6593 QCwidth
= intern (":width");
6594 staticpro (&QCwidth
);
6595 QCfont
= intern (":font");
6596 staticpro (&QCfont
);
6597 QCbold
= intern (":bold");
6598 staticpro (&QCbold
);
6599 QCitalic
= intern (":italic");
6600 staticpro (&QCitalic
);
6601 QCoverline
= intern (":overline");
6602 staticpro (&QCoverline
);
6603 QCstrike_through
= intern (":strike-through");
6604 staticpro (&QCstrike_through
);
6605 QCbox
= intern (":box");
6608 /* Symbols used for Lisp face attribute values. */
6609 QCcolor
= intern (":color");
6610 staticpro (&QCcolor
);
6611 QCline_width
= intern (":line-width");
6612 staticpro (&QCline_width
);
6613 QCstyle
= intern (":style");
6614 staticpro (&QCstyle
);
6615 Qreleased_button
= intern ("released-button");
6616 staticpro (&Qreleased_button
);
6617 Qpressed_button
= intern ("pressed-button");
6618 staticpro (&Qpressed_button
);
6619 Qnormal
= intern ("normal");
6620 staticpro (&Qnormal
);
6621 Qultra_light
= intern ("ultra-light");
6622 staticpro (&Qultra_light
);
6623 Qextra_light
= intern ("extra-light");
6624 staticpro (&Qextra_light
);
6625 Qlight
= intern ("light");
6626 staticpro (&Qlight
);
6627 Qsemi_light
= intern ("semi-light");
6628 staticpro (&Qsemi_light
);
6629 Qsemi_bold
= intern ("semi-bold");
6630 staticpro (&Qsemi_bold
);
6631 Qbold
= intern ("bold");
6633 Qextra_bold
= intern ("extra-bold");
6634 staticpro (&Qextra_bold
);
6635 Qultra_bold
= intern ("ultra-bold");
6636 staticpro (&Qultra_bold
);
6637 Qoblique
= intern ("oblique");
6638 staticpro (&Qoblique
);
6639 Qitalic
= intern ("italic");
6640 staticpro (&Qitalic
);
6641 Qreverse_oblique
= intern ("reverse-oblique");
6642 staticpro (&Qreverse_oblique
);
6643 Qreverse_italic
= intern ("reverse-italic");
6644 staticpro (&Qreverse_italic
);
6645 Qultra_condensed
= intern ("ultra-condensed");
6646 staticpro (&Qultra_condensed
);
6647 Qextra_condensed
= intern ("extra-condensed");
6648 staticpro (&Qextra_condensed
);
6649 Qcondensed
= intern ("condensed");
6650 staticpro (&Qcondensed
);
6651 Qsemi_condensed
= intern ("semi-condensed");
6652 staticpro (&Qsemi_condensed
);
6653 Qsemi_expanded
= intern ("semi-expanded");
6654 staticpro (&Qsemi_expanded
);
6655 Qexpanded
= intern ("expanded");
6656 staticpro (&Qexpanded
);
6657 Qextra_expanded
= intern ("extra-expanded");
6658 staticpro (&Qextra_expanded
);
6659 Qultra_expanded
= intern ("ultra-expanded");
6660 staticpro (&Qultra_expanded
);
6661 Qbackground_color
= intern ("background-color");
6662 staticpro (&Qbackground_color
);
6663 Qforeground_color
= intern ("foreground-color");
6664 staticpro (&Qforeground_color
);
6665 Qunspecified
= intern ("unspecified");
6666 staticpro (&Qunspecified
);
6668 Qx_charset_registry
= intern ("x-charset-registry");
6669 staticpro (&Qx_charset_registry
);
6670 Qface_alias
= intern ("face-alias");
6671 staticpro (&Qface_alias
);
6672 Qdefault
= intern ("default");
6673 staticpro (&Qdefault
);
6674 Qtool_bar
= intern ("tool-bar");
6675 staticpro (&Qtool_bar
);
6676 Qregion
= intern ("region");
6677 staticpro (&Qregion
);
6678 Qfringe
= intern ("fringe");
6679 staticpro (&Qfringe
);
6680 Qheader_line
= intern ("header-line");
6681 staticpro (&Qheader_line
);
6682 Qscroll_bar
= intern ("scroll-bar");
6683 staticpro (&Qscroll_bar
);
6684 Qmenu
= intern ("menu");
6686 Qcursor
= intern ("cursor");
6687 staticpro (&Qcursor
);
6688 Qborder
= intern ("border");
6689 staticpro (&Qborder
);
6690 Qmouse
= intern ("mouse");
6691 staticpro (&Qmouse
);
6692 Qtty_color_desc
= intern ("tty-color-desc");
6693 staticpro (&Qtty_color_desc
);
6694 Qtty_color_by_index
= intern ("tty-color-by-index");
6695 staticpro (&Qtty_color_by_index
);
6697 defsubr (&Sinternal_make_lisp_face
);
6698 defsubr (&Sinternal_lisp_face_p
);
6699 defsubr (&Sinternal_set_lisp_face_attribute
);
6700 #ifdef HAVE_X_WINDOWS
6701 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6703 defsubr (&Scolor_gray_p
);
6704 defsubr (&Scolor_supported_p
);
6705 defsubr (&Sinternal_get_lisp_face_attribute
);
6706 defsubr (&Sinternal_lisp_face_attribute_values
);
6707 defsubr (&Sinternal_lisp_face_equal_p
);
6708 defsubr (&Sinternal_lisp_face_empty_p
);
6709 defsubr (&Sinternal_copy_lisp_face
);
6710 defsubr (&Sinternal_merge_in_global_face
);
6711 defsubr (&Sface_font
);
6712 defsubr (&Sframe_face_alist
);
6713 defsubr (&Sinternal_set_font_selection_order
);
6714 defsubr (&Sinternal_set_alternative_font_family_alist
);
6716 defsubr (&Sdump_face
);
6717 defsubr (&Sshow_face_resources
);
6718 #endif /* GLYPH_DEBUG */
6719 defsubr (&Sclear_face_cache
);
6721 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6722 "*Limit for font matching.\n\
6723 If an integer > 0, font matching functions won't load more than\n\
6724 that number of fonts when searching for a matching font.");
6725 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6727 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6728 "List of global face definitions (for internal use only.)");
6729 Vface_new_frame_defaults
= Qnil
;
6731 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6732 "*Default stipple pattern used on monochrome displays.\n\
6733 This stipple pattern is used on monochrome displays\n\
6734 instead of shades of gray for a face background color.\n\
6735 See `set-face-stipple' for possible values for this variable.");
6736 Vface_default_stipple
= build_string ("gray3");
6738 DEFVAR_LISP ("face-default-registry", &Vface_default_registry
,
6739 "Default registry and encoding to use.\n\
6740 This registry and encoding is used for unibyte text. It is set up\n\
6741 from the specified frame font when Emacs starts. (For internal use only.)");
6742 Vface_default_registry
= Qnil
;
6744 DEFVAR_LISP ("face-alternative-font-family-alist",
6745 &Vface_alternative_font_family_alist
, "");
6746 Vface_alternative_font_family_alist
= Qnil
;
6750 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6751 "Allowed scalable fonts.\n\
6752 A value of nil means don't allow any scalable fonts.\n\
6753 A value of t means allow any scalable font.\n\
6754 Otherwise, value must be a list of regular expressions. A font may be\n\
6755 scaled if its name matches a regular expression in the list.");
6756 Vscalable_fonts_allowed
= Qnil
;
6758 #endif /* SCALABLE_FONTS */
6760 #ifdef HAVE_X_WINDOWS
6761 defsubr (&Sbitmap_spec_p
);
6762 defsubr (&Sx_list_fonts
);
6763 defsubr (&Sinternal_face_x_get_resource
);
6764 defsubr (&Sx_family_fonts
);
6765 defsubr (&Sx_font_family_list
);
6766 #endif /* HAVE_X_WINDOWS */