1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. Font or fontset pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
195 #include <sys/types.h>
196 #include <sys/stat.h>
201 #ifdef HAVE_WINDOW_SYSTEM
203 #endif /* HAVE_WINDOW_SYSTEM */
205 #ifdef HAVE_X_WINDOWS
209 #include <Xm/XmStrDefs.h>
210 #endif /* USE_MOTIF */
211 #endif /* HAVE_X_WINDOWS */
220 /* Redefine X specifics to W32 equivalents to avoid cluttering the
221 code with #ifdef blocks. */
222 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
223 #define x_display_info w32_display_info
224 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
225 #define check_x check_w32
226 #define x_list_fonts w32_list_fonts
227 #define GCGraphicsExposures 0
228 /* For historic reasons, FONT_WIDTH refers to average width on W32,
229 not maximum as on X. Redefine here. */
230 #define FONT_WIDTH FONT_MAX_WIDTH
231 #endif /* WINDOWSNT */
235 #define x_display_info mac_display_info
236 #define check_x check_mac
238 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
241 x_create_gc (f
, mask
, xgcv
)
247 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
256 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
261 #include "dispextern.h"
262 #include "blockinput.h"
264 #include "intervals.h"
266 #ifdef HAVE_X_WINDOWS
268 /* Compensate for a bug in Xos.h on some systems, on which it requires
269 time.h. On some such systems, Xos.h tries to redefine struct
270 timeval and struct timezone if USG is #defined while it is
273 #ifdef XOS_NEEDS_TIME_H
279 #else /* not XOS_NEEDS_TIME_H */
281 #endif /* not XOS_NEEDS_TIME_H */
283 #endif /* HAVE_X_WINDOWS */
287 #include "keyboard.h"
290 #define max(A, B) ((A) > (B) ? (A) : (B))
291 #define min(A, B) ((A) < (B) ? (A) : (B))
292 #define abs(X) ((X) < 0 ? -(X) : (X))
295 /* Number of pt per inch (from the TeXbook). */
297 #define PT_PER_INCH 72.27
299 /* Non-zero if face attribute ATTR is unspecified. */
301 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
303 /* Value is the number of elements of VECTOR. */
305 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
307 /* Make a copy of string S on the stack using alloca. Value is a pointer
310 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
312 /* Make a copy of the contents of Lisp string S on the stack using
313 alloca. Value is a pointer to the copy. */
315 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
317 /* Size of hash table of realized faces in face caches (should be a
320 #define FACE_CACHE_BUCKETS_SIZE 1001
322 /* A definition of XColor for non-X frames. */
324 #ifndef HAVE_X_WINDOWS
329 unsigned short red
, green
, blue
;
335 #endif /* not HAVE_X_WINDOWS */
337 /* Keyword symbols used for face attribute names. */
339 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
340 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
341 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
342 Lisp_Object QCreverse_video
;
343 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
345 /* Symbols used for attribute values. */
347 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
348 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
349 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
350 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
351 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
352 Lisp_Object Qultra_expanded
;
353 Lisp_Object Qreleased_button
, Qpressed_button
;
354 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
355 Lisp_Object Qunspecified
;
357 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
359 /* The name of the function to call when the background of the frame
360 has changed, frame_update_face_colors. */
362 Lisp_Object Qframe_update_face_colors
;
364 /* Names of basic faces. */
366 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
367 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
368 extern Lisp_Object Qmode_line
;
370 /* The symbol `face-alias'. A symbols having that property is an
371 alias for another face. Value of the property is the name of
374 Lisp_Object Qface_alias
;
376 /* Names of frame parameters related to faces. */
378 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
379 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
381 /* Default stipple pattern used on monochrome displays. This stipple
382 pattern is used on monochrome displays instead of shades of gray
383 for a face background color. See `set-face-stipple' for possible
384 values for this variable. */
386 Lisp_Object Vface_default_stipple
;
388 /* Alist of alternative font families. Each element is of the form
389 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
390 try FAMILY1, then FAMILY2, ... */
392 Lisp_Object Vface_alternative_font_family_alist
;
394 /* Alist of alternative font registries. Each element is of the form
395 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
396 loaded, try REGISTRY1, then REGISTRY2, ... */
398 Lisp_Object Vface_alternative_font_registry_alist
;
400 /* Allowed scalable fonts. A value of nil means don't allow any
401 scalable fonts. A value of t means allow the use of any scalable
402 font. Otherwise, value must be a list of regular expressions. A
403 font may be scaled if its name matches a regular expression in the
406 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
408 /* List of regular expressions that matches names of fonts to ignore. */
410 Lisp_Object Vface_ignored_fonts
;
412 /* Maximum number of fonts to consider in font_list. If not an
413 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
415 Lisp_Object Vfont_list_limit
;
416 #define DEFAULT_FONT_LIST_LIMIT 100
418 /* The symbols `foreground-color' and `background-color' which can be
419 used as part of a `face' property. This is for compatibility with
422 Lisp_Object Qforeground_color
, Qbackground_color
;
424 /* The symbols `face' and `mouse-face' used as text properties. */
427 extern Lisp_Object Qmouse_face
;
429 /* Error symbol for wrong_type_argument in load_pixmap. */
431 Lisp_Object Qbitmap_spec_p
;
433 /* Alist of global face definitions. Each element is of the form
434 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
435 is a Lisp vector of face attributes. These faces are used
436 to initialize faces for new frames. */
438 Lisp_Object Vface_new_frame_defaults
;
440 /* The next ID to assign to Lisp faces. */
442 static int next_lface_id
;
444 /* A vector mapping Lisp face Id's to face names. */
446 static Lisp_Object
*lface_id_to_name
;
447 static int lface_id_to_name_size
;
449 /* TTY color-related functions (defined in tty-colors.el). */
451 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
453 /* The name of the function used to compute colors on TTYs. */
455 Lisp_Object Qtty_color_alist
;
457 /* An alist of defined terminal colors and their RGB values. */
459 Lisp_Object Vtty_defined_color_alist
;
461 /* Counter for calls to clear_face_cache. If this counter reaches
462 CLEAR_FONT_TABLE_COUNT, and a frame has more than
463 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
465 static int clear_font_table_count
;
466 #define CLEAR_FONT_TABLE_COUNT 100
467 #define CLEAR_FONT_TABLE_NFONTS 10
469 /* Non-zero means face attributes have been changed since the last
470 redisplay. Used in redisplay_internal. */
472 int face_change_count
;
474 /* Incremented for every change in the `menu' face. */
476 int menu_face_change_count
;
478 /* Non-zero means don't display bold text if a face's foreground
479 and background colors are the inverse of the default colors of the
480 display. This is a kluge to suppress `bold black' foreground text
481 which is hard to read on an LCD monitor. */
483 int tty_suppress_bold_inverse_default_colors_p
;
485 /* A list of the form `((x . y))' used to avoid consing in
486 Finternal_set_lisp_face_attribute. */
488 static Lisp_Object Vparam_value_alist
;
490 /* The total number of colors currently allocated. */
493 static int ncolors_allocated
;
494 static int npixmaps_allocated
;
500 /* Function prototypes. */
505 static void map_tty_color
P_ ((struct frame
*, struct face
*,
506 enum lface_attribute_index
, int *));
507 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
508 static int may_use_scalable_font_p
P_ ((char *));
509 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
510 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
512 static int x_face_list_fonts
P_ ((struct frame
*, char *,
513 struct font_name
*, int, int));
514 static int font_scalable_p
P_ ((struct font_name
*));
515 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
516 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
517 static unsigned char *xstrlwr
P_ ((unsigned char *));
518 static void signal_error
P_ ((char *, Lisp_Object
));
519 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
520 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
521 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
522 static void free_face_colors
P_ ((struct frame
*, struct face
*));
523 static int face_color_gray_p
P_ ((struct frame
*, char *));
524 static char *build_font_name
P_ ((struct font_name
*));
525 static void free_font_names
P_ ((struct font_name
*, int));
526 static int sorted_font_list
P_ ((struct frame
*, char *,
527 int (*cmpfn
) P_ ((const void *, const void *)),
528 struct font_name
**));
529 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
530 Lisp_Object
, struct font_name
**));
531 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
532 Lisp_Object
, struct font_name
**));
533 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
534 Lisp_Object
, Lisp_Object
, struct font_name
**));
535 static int cmp_font_names
P_ ((const void *, const void *));
536 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
537 struct face
*, int));
538 static struct face
*realize_x_face
P_ ((struct face_cache
*,
539 Lisp_Object
*, int, struct face
*));
540 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
541 Lisp_Object
*, int));
542 static int realize_basic_faces
P_ ((struct frame
*));
543 static int realize_default_face
P_ ((struct frame
*));
544 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
545 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
546 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
547 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
548 static unsigned lface_hash
P_ ((Lisp_Object
*));
549 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
550 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
551 static void free_realized_face
P_ ((struct frame
*, struct face
*));
552 static void clear_face_gcs
P_ ((struct face_cache
*));
553 static void free_face_cache
P_ ((struct face_cache
*));
554 static int face_numeric_weight
P_ ((Lisp_Object
));
555 static int face_numeric_slant
P_ ((Lisp_Object
));
556 static int face_numeric_swidth
P_ ((Lisp_Object
));
557 static int face_fontset
P_ ((Lisp_Object
*));
558 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
559 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
560 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
561 Lisp_Object
*, Lisp_Object
));
562 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
564 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
565 Lisp_Object
, int, int));
566 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
567 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
568 static void free_realized_faces
P_ ((struct face_cache
*));
569 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
570 struct font_name
*, int, int));
571 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
572 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
573 static int xlfd_numeric_slant
P_ ((struct font_name
*));
574 static int xlfd_numeric_weight
P_ ((struct font_name
*));
575 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
576 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
577 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
578 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
579 static int xlfd_fixed_p
P_ ((struct font_name
*));
580 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
582 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
583 struct font_name
*, int,
585 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
586 struct font_name
*, int));
588 #ifdef HAVE_WINDOW_SYSTEM
590 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
591 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
592 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
593 int (*cmpfn
) P_ ((const void *, const void *))));
594 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
595 static void x_free_gc
P_ ((struct frame
*, GC
));
596 static void clear_font_table
P_ ((struct frame
*));
599 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
600 #endif /* WINDOWSNT */
603 static void x_update_menu_appearance
P_ ((struct frame
*));
604 #endif /* USE_X_TOOLKIT */
606 #endif /* HAVE_WINDOW_SYSTEM */
609 /***********************************************************************
611 ***********************************************************************/
613 #ifdef HAVE_X_WINDOWS
615 #ifdef DEBUG_X_COLORS
617 /* The following is a poor mans infrastructure for debugging X color
618 allocation problems on displays with PseudoColor-8. Some X servers
619 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
620 color reference counts completely so that they don't signal an
621 error when a color is freed whose reference count is already 0.
622 Other X servers do. To help me debug this, the following code
623 implements a simple reference counting schema of its own, for a
624 single display/screen. --gerd. */
626 /* Reference counts for pixel colors. */
628 int color_count
[256];
630 /* Register color PIXEL as allocated. */
633 register_color (pixel
)
636 xassert (pixel
< 256);
637 ++color_count
[pixel
];
641 /* Register color PIXEL as deallocated. */
644 unregister_color (pixel
)
647 xassert (pixel
< 256);
648 if (color_count
[pixel
] > 0)
649 --color_count
[pixel
];
655 /* Register N colors from PIXELS as deallocated. */
658 unregister_colors (pixels
, n
)
659 unsigned long *pixels
;
663 for (i
= 0; i
< n
; ++i
)
664 unregister_color (pixels
[i
]);
668 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
669 "Dump currently allocated colors and their reference counts to stderr.")
674 fputc ('\n', stderr
);
676 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
679 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
682 fputc ('\n', stderr
);
684 fputc ('\t', stderr
);
688 fputc ('\n', stderr
);
692 #endif /* DEBUG_X_COLORS */
695 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
696 color values. Interrupt input must be blocked when this function
700 x_free_colors (f
, pixels
, npixels
)
702 unsigned long *pixels
;
705 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
707 /* If display has an immutable color map, freeing colors is not
708 necessary and some servers don't allow it. So don't do it. */
709 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
711 #ifdef DEBUG_X_COLORS
712 unregister_colors (pixels
, npixels
);
714 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
720 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
721 color values. Interrupt input must be blocked when this function
725 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
729 unsigned long *pixels
;
732 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
733 int class = dpyinfo
->visual
->class;
735 /* If display has an immutable color map, freeing colors is not
736 necessary and some servers don't allow it. So don't do it. */
737 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
739 #ifdef DEBUG_X_COLORS
740 unregister_colors (pixels
, npixels
);
742 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
747 /* Create and return a GC for use on frame F. GC values and mask
748 are given by XGCV and MASK. */
751 x_create_gc (f
, mask
, xgcv
)
758 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
765 /* Free GC which was used on frame F. */
773 xassert (--ngcs
>= 0);
774 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
778 #endif /* HAVE_X_WINDOWS */
781 /* W32 emulation of GCs */
784 x_create_gc (f
, mask
, xgcv
)
791 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
798 /* Free GC which was used on frame F. */
806 xassert (--ngcs
>= 0);
811 #endif /* WINDOWSNT */
813 /* Like stricmp. Used to compare parts of font names which are in
818 unsigned char *s1
, *s2
;
822 unsigned char c1
= tolower (*s1
);
823 unsigned char c2
= tolower (*s2
);
825 return c1
< c2
? -1 : 1;
830 return *s2
== 0 ? 0 : -1;
835 /* Like strlwr, which might not always be available. */
837 static unsigned char *
841 unsigned char *p
= s
;
850 /* Signal `error' with message S, and additional argument ARG. */
853 signal_error (s
, arg
)
857 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
861 /* If FRAME is nil, return a pointer to the selected frame.
862 Otherwise, check that FRAME is a live frame, and return a pointer
863 to it. NPARAM is the parameter number of FRAME, for
864 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
865 Lisp function definitions. */
867 static INLINE
struct frame
*
868 frame_or_selected_frame (frame
, nparam
)
873 frame
= selected_frame
;
875 CHECK_LIVE_FRAME (frame
, nparam
);
876 return XFRAME (frame
);
880 /***********************************************************************
882 ***********************************************************************/
884 /* Initialize face cache and basic faces for frame F. */
890 /* Make a face cache, if F doesn't have one. */
891 if (FRAME_FACE_CACHE (f
) == NULL
)
892 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
894 #ifdef HAVE_WINDOW_SYSTEM
895 /* Make the image cache. */
896 if (FRAME_WINDOW_P (f
))
898 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
899 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
900 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
902 #endif /* HAVE_WINDOW_SYSTEM */
904 /* Realize basic faces. Must have enough information in frame
905 parameters to realize basic faces at this point. */
906 #ifdef HAVE_X_WINDOWS
907 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
910 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
912 if (!realize_basic_faces (f
))
917 /* Free face cache of frame F. Called from Fdelete_frame. */
923 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
927 free_face_cache (face_cache
);
928 FRAME_FACE_CACHE (f
) = NULL
;
931 #ifdef HAVE_WINDOW_SYSTEM
932 if (FRAME_WINDOW_P (f
))
934 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
937 --image_cache
->refcount
;
938 if (image_cache
->refcount
== 0)
939 free_image_cache (f
);
942 #endif /* HAVE_WINDOW_SYSTEM */
946 /* Clear face caches, and recompute basic faces for frame F. Call
947 this after changing frame parameters on which those faces depend,
948 or when realized faces have been freed due to changing attributes
952 recompute_basic_faces (f
)
955 if (FRAME_FACE_CACHE (f
))
957 clear_face_cache (0);
958 if (!realize_basic_faces (f
))
964 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
965 try to free unused fonts, too. */
968 clear_face_cache (clear_fonts_p
)
971 #ifdef HAVE_WINDOW_SYSTEM
972 Lisp_Object tail
, frame
;
976 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
978 /* From time to time see if we can unload some fonts. This also
979 frees all realized faces on all frames. Fonts needed by
980 faces will be loaded again when faces are realized again. */
981 clear_font_table_count
= 0;
983 FOR_EACH_FRAME (tail
, frame
)
986 if (FRAME_WINDOW_P (f
)
987 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
989 free_all_realized_faces (frame
);
990 clear_font_table (f
);
996 /* Clear GCs of realized faces. */
997 FOR_EACH_FRAME (tail
, frame
)
1000 if (FRAME_WINDOW_P (f
))
1002 clear_face_gcs (FRAME_FACE_CACHE (f
));
1003 clear_image_cache (f
, 0);
1007 #endif /* HAVE_WINDOW_SYSTEM */
1011 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1012 "Clear face caches on all frames.\n\
1013 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
1015 Lisp_Object thoroughly
;
1017 clear_face_cache (!NILP (thoroughly
));
1018 ++face_change_count
;
1019 ++windows_or_buffers_changed
;
1025 #ifdef HAVE_WINDOW_SYSTEM
1028 /* Remove those fonts from the font table of frame F exept for the
1029 default ASCII font for the frame. Called from clear_face_cache
1030 from time to time. */
1033 clear_font_table (f
)
1036 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1039 xassert (FRAME_WINDOW_P (f
));
1041 /* Free those fonts that are not used by the frame F as the default. */
1042 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1044 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1046 if (!font_info
->name
1047 || font_info
->font
== FRAME_FONT (f
))
1051 if (font_info
->full_name
!= font_info
->name
)
1052 xfree (font_info
->full_name
);
1053 xfree (font_info
->name
);
1055 /* Free the font. */
1057 #ifdef HAVE_X_WINDOWS
1058 XFreeFont (dpyinfo
->display
, font_info
->font
);
1061 w32_unload_font (dpyinfo
, font_info
->font
);
1065 /* Mark font table slot free. */
1066 font_info
->font
= NULL
;
1067 font_info
->name
= font_info
->full_name
= NULL
;
1071 #endif /* HAVE_WINDOW_SYSTEM */
1075 /***********************************************************************
1077 ***********************************************************************/
1079 #ifdef HAVE_WINDOW_SYSTEM
1081 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1082 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1083 A bitmap specification is either a string, a file name, or a list\n\
1084 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1085 HEIGHT is its height, and DATA is a string containing the bits of\n\
1086 the pixmap. Bits are stored row by row, each row occupies\n\
1087 (WIDTH + 7)/8 bytes.")
1093 if (STRINGP (object
))
1094 /* If OBJECT is a string, it's a file name. */
1096 else if (CONSP (object
))
1098 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1099 HEIGHT must be integers > 0, and DATA must be string large
1100 enough to hold a bitmap of the specified size. */
1101 Lisp_Object width
, height
, data
;
1103 height
= width
= data
= Qnil
;
1107 width
= XCAR (object
);
1108 object
= XCDR (object
);
1111 height
= XCAR (object
);
1112 object
= XCDR (object
);
1114 data
= XCAR (object
);
1118 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1120 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1122 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1127 return pixmap_p
? Qt
: Qnil
;
1131 /* Load a bitmap according to NAME (which is either a file name or a
1132 pixmap spec) for use on frame F. Value is the bitmap_id (see
1133 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1134 bitmap cannot be loaded, display a message saying so, and return
1135 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1136 if these pointers are not null. */
1139 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1142 unsigned int *w_ptr
, *h_ptr
;
1150 tem
= Fbitmap_spec_p (name
);
1152 wrong_type_argument (Qbitmap_spec_p
, name
);
1157 /* Decode a bitmap spec into a bitmap. */
1162 w
= XINT (Fcar (name
));
1163 h
= XINT (Fcar (Fcdr (name
)));
1164 bits
= Fcar (Fcdr (Fcdr (name
)));
1166 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1171 /* It must be a string -- a file name. */
1172 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1178 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1189 ++npixmaps_allocated
;
1192 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1195 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1201 #endif /* HAVE_WINDOW_SYSTEM */
1205 /***********************************************************************
1207 ***********************************************************************/
1209 #ifdef HAVE_WINDOW_SYSTEM
1211 /* Update the line_height of frame F. Return non-zero if line height
1215 frame_update_line_height (f
)
1218 int line_height
, changed_p
;
1220 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1221 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1222 FRAME_LINE_HEIGHT (f
) = line_height
;
1226 #endif /* HAVE_WINDOW_SYSTEM */
1229 /***********************************************************************
1231 ***********************************************************************/
1233 #ifdef HAVE_WINDOW_SYSTEM
1235 /* Load font of face FACE which is used on frame F to display
1236 character C. The name of the font to load is determined by lface
1237 and fontset of FACE. */
1240 load_face_font (f
, face
, c
)
1245 struct font_info
*font_info
= NULL
;
1248 face
->font_info_id
= -1;
1251 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1256 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1261 face
->font_info_id
= font_info
->font_idx
;
1262 face
->font
= font_info
->font
;
1263 face
->font_name
= font_info
->full_name
;
1266 x_free_gc (f
, face
->gc
);
1271 add_to_log ("Unable to load font %s",
1272 build_string (font_name
), Qnil
);
1276 #endif /* HAVE_WINDOW_SYSTEM */
1280 /***********************************************************************
1282 ***********************************************************************/
1284 /* A version of defined_color for non-X frames. */
1287 tty_defined_color (f
, color_name
, color_def
, alloc
)
1293 Lisp_Object color_desc
;
1294 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1295 unsigned long red
= 0, green
= 0, blue
= 0;
1298 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1302 XSETFRAME (frame
, f
);
1304 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1305 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1307 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1308 if (CONSP (XCDR (XCDR (color_desc
))))
1310 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1311 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1312 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1316 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1317 /* We were called early during startup, and the colors are not
1318 yet set up in tty-defined-color-alist. Don't return a failure
1319 indication, since this produces the annoying "Unable to
1320 load color" messages in the *Messages* buffer. */
1323 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1325 if (strcmp (color_name
, "unspecified-fg") == 0)
1326 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1327 else if (strcmp (color_name
, "unspecified-bg") == 0)
1328 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1331 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1334 color_def
->pixel
= color_idx
;
1335 color_def
->red
= red
;
1336 color_def
->green
= green
;
1337 color_def
->blue
= blue
;
1343 /* Decide if color named COLOR_NAME is valid for the display
1344 associated with the frame F; if so, return the rgb values in
1345 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1347 This does the right thing for any type of frame. */
1350 defined_color (f
, color_name
, color_def
, alloc
)
1356 if (!FRAME_WINDOW_P (f
))
1357 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1358 #ifdef HAVE_X_WINDOWS
1359 else if (FRAME_X_P (f
))
1360 return x_defined_color (f
, color_name
, color_def
, alloc
);
1363 else if (FRAME_W32_P (f
))
1364 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1367 else if (FRAME_MAC_P (f
))
1368 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1375 /* Given the index IDX of a tty color on frame F, return its name, a
1379 tty_color_name (f
, idx
)
1383 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1386 Lisp_Object coldesc
;
1388 XSETFRAME (frame
, f
);
1389 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1391 if (!NILP (coldesc
))
1392 return XCAR (coldesc
);
1395 /* We can have an MSDOG frame under -nw for a short window of
1396 opportunity before internal_terminal_init is called. DTRT. */
1397 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1398 return msdos_stdcolor_name (idx
);
1401 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1402 return build_string (unspecified_fg
);
1403 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1404 return build_string (unspecified_bg
);
1407 return vga_stdcolor_name (idx
);
1410 return Qunspecified
;
1414 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1415 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1418 face_color_gray_p (f
, color_name
)
1425 if (defined_color (f
, color_name
, &color
, 0))
1426 gray_p
= ((abs (color
.red
- color
.green
)
1427 < max (color
.red
, color
.green
) / 20)
1428 && (abs (color
.green
- color
.blue
)
1429 < max (color
.green
, color
.blue
) / 20)
1430 && (abs (color
.blue
- color
.red
)
1431 < max (color
.blue
, color
.red
) / 20));
1439 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1440 BACKGROUND_P non-zero means the color will be used as background
1444 face_color_supported_p (f
, color_name
, background_p
)
1452 XSETFRAME (frame
, f
);
1453 return (FRAME_WINDOW_P (f
)
1454 ? (!NILP (Fxw_display_color_p (frame
))
1455 || xstricmp (color_name
, "black") == 0
1456 || xstricmp (color_name
, "white") == 0
1458 && face_color_gray_p (f
, color_name
))
1459 || (!NILP (Fx_display_grayscale_p (frame
))
1460 && face_color_gray_p (f
, color_name
)))
1461 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1465 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1466 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1467 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1468 If FRAME is nil or omitted, use the selected frame.")
1470 Lisp_Object color
, frame
;
1474 CHECK_FRAME (frame
, 0);
1475 CHECK_STRING (color
, 0);
1477 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1481 DEFUN ("color-supported-p", Fcolor_supported_p
,
1482 Scolor_supported_p
, 2, 3, 0,
1483 "Return non-nil if COLOR can be displayed on FRAME.\n\
1484 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1485 If FRAME is nil or omitted, use the selected frame.\n\
1486 COLOR must be a valid color name.")
1487 (color
, frame
, background_p
)
1488 Lisp_Object frame
, color
, background_p
;
1492 CHECK_FRAME (frame
, 0);
1493 CHECK_STRING (color
, 0);
1495 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1501 /* Load color with name NAME for use by face FACE on frame F.
1502 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1503 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1504 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1505 pixel color. If color cannot be loaded, display a message, and
1506 return the foreground, background or underline color of F, but
1507 record that fact in flags of the face so that we don't try to free
1511 load_color (f
, face
, name
, target_index
)
1515 enum lface_attribute_index target_index
;
1519 xassert (STRINGP (name
));
1520 xassert (target_index
== LFACE_FOREGROUND_INDEX
1521 || target_index
== LFACE_BACKGROUND_INDEX
1522 || target_index
== LFACE_UNDERLINE_INDEX
1523 || target_index
== LFACE_OVERLINE_INDEX
1524 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1525 || target_index
== LFACE_BOX_INDEX
);
1527 /* if the color map is full, defined_color will return a best match
1528 to the values in an existing cell. */
1529 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1531 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1533 switch (target_index
)
1535 case LFACE_FOREGROUND_INDEX
:
1536 face
->foreground_defaulted_p
= 1;
1537 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1540 case LFACE_BACKGROUND_INDEX
:
1541 face
->background_defaulted_p
= 1;
1542 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1545 case LFACE_UNDERLINE_INDEX
:
1546 face
->underline_defaulted_p
= 1;
1547 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1550 case LFACE_OVERLINE_INDEX
:
1551 face
->overline_color_defaulted_p
= 1;
1552 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1555 case LFACE_STRIKE_THROUGH_INDEX
:
1556 face
->strike_through_color_defaulted_p
= 1;
1557 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1560 case LFACE_BOX_INDEX
:
1561 face
->box_color_defaulted_p
= 1;
1562 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1571 ++ncolors_allocated
;
1578 #ifdef HAVE_WINDOW_SYSTEM
1580 /* Load colors for face FACE which is used on frame F. Colors are
1581 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1582 of ATTRS. If the background color specified is not supported on F,
1583 try to emulate gray colors with a stipple from Vface_default_stipple. */
1586 load_face_colors (f
, face
, attrs
)
1593 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1594 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1596 /* Swap colors if face is inverse-video. */
1597 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1605 /* Check for support for foreground, not for background because
1606 face_color_supported_p is smart enough to know that grays are
1607 "supported" as background because we are supposed to use stipple
1609 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1610 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1612 x_destroy_bitmap (f
, face
->stipple
);
1613 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1614 &face
->pixmap_w
, &face
->pixmap_h
);
1617 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1618 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1622 /* Free color PIXEL on frame F. */
1625 unload_color (f
, pixel
)
1627 unsigned long pixel
;
1629 #ifdef HAVE_X_WINDOWS
1631 x_free_colors (f
, &pixel
, 1);
1637 /* Free colors allocated for FACE. */
1640 free_face_colors (f
, face
)
1644 #ifdef HAVE_X_WINDOWS
1647 if (!face
->foreground_defaulted_p
)
1649 x_free_colors (f
, &face
->foreground
, 1);
1650 IF_DEBUG (--ncolors_allocated
);
1653 if (!face
->background_defaulted_p
)
1655 x_free_colors (f
, &face
->background
, 1);
1656 IF_DEBUG (--ncolors_allocated
);
1659 if (face
->underline_p
1660 && !face
->underline_defaulted_p
)
1662 x_free_colors (f
, &face
->underline_color
, 1);
1663 IF_DEBUG (--ncolors_allocated
);
1666 if (face
->overline_p
1667 && !face
->overline_color_defaulted_p
)
1669 x_free_colors (f
, &face
->overline_color
, 1);
1670 IF_DEBUG (--ncolors_allocated
);
1673 if (face
->strike_through_p
1674 && !face
->strike_through_color_defaulted_p
)
1676 x_free_colors (f
, &face
->strike_through_color
, 1);
1677 IF_DEBUG (--ncolors_allocated
);
1680 if (face
->box
!= FACE_NO_BOX
1681 && !face
->box_color_defaulted_p
)
1683 x_free_colors (f
, &face
->box_color
, 1);
1684 IF_DEBUG (--ncolors_allocated
);
1688 #endif /* HAVE_X_WINDOWS */
1691 #endif /* HAVE_WINDOW_SYSTEM */
1695 /***********************************************************************
1697 ***********************************************************************/
1699 /* An enumerator for each field of an XLFD font name. */
1720 /* An enumerator for each possible slant value of a font. Taken from
1721 the XLFD specification. */
1729 XLFD_SLANT_REVERSE_ITALIC
,
1730 XLFD_SLANT_REVERSE_OBLIQUE
,
1734 /* Relative font weight according to XLFD documentation. */
1738 XLFD_WEIGHT_UNKNOWN
,
1739 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1740 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1741 XLFD_WEIGHT_LIGHT
, /* 30 */
1742 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1743 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1744 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1745 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1746 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1747 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1750 /* Relative proportionate width. */
1754 XLFD_SWIDTH_UNKNOWN
,
1755 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1756 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1757 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1758 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1759 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1760 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1761 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1762 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1763 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1766 /* Structure used for tables mapping XLFD weight, slant, and width
1767 names to numeric and symbolic values. */
1773 Lisp_Object
*symbol
;
1776 /* Table of XLFD slant names and their numeric and symbolic
1777 representations. This table must be sorted by slant names in
1780 static struct table_entry slant_table
[] =
1782 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1783 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1784 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1785 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1786 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1787 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1790 /* Table of XLFD weight names. This table must be sorted by weight
1791 names in ascending order. */
1793 static struct table_entry weight_table
[] =
1795 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1796 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1797 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1798 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1799 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1800 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1801 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1802 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1803 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1804 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1805 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1806 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1807 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1808 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1809 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1810 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1813 /* Table of XLFD width names. This table must be sorted by width
1814 names in ascending order. */
1816 static struct table_entry swidth_table
[] =
1818 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1819 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1820 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1821 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1822 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1823 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1824 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1825 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1826 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1827 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1828 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1829 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1830 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1831 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1832 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1835 /* Structure used to hold the result of splitting font names in XLFD
1836 format into their fields. */
1840 /* The original name which is modified destructively by
1841 split_font_name. The pointer is kept here to be able to free it
1842 if it was allocated from the heap. */
1845 /* Font name fields. Each vector element points into `name' above.
1846 Fields are NUL-terminated. */
1847 char *fields
[XLFD_LAST
];
1849 /* Numeric values for those fields that interest us. See
1850 split_font_name for which these are. */
1851 int numeric
[XLFD_LAST
];
1853 /* Lower value mean higher priority. */
1854 int registry_priority
;
1857 /* The frame in effect when sorting font names. Set temporarily in
1858 sort_fonts so that it is available in font comparison functions. */
1860 static struct frame
*font_frame
;
1862 /* Order by which font selection chooses fonts. The default values
1863 mean `first, find a best match for the font width, then for the
1864 font height, then for weight, then for slant.' This variable can be
1865 set via set-face-font-sort-order. */
1868 static int font_sort_order
[4] = {
1869 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1872 static int font_sort_order
[4];
1875 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1876 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1877 is a pointer to the matching table entry or null if no table entry
1880 static struct table_entry
*
1881 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1882 struct table_entry
*table
;
1884 struct font_name
*font
;
1887 /* Function split_font_name converts fields to lower-case, so there
1888 is no need to use xstrlwr or xstricmp here. */
1889 char *s
= font
->fields
[field_index
];
1890 int low
, mid
, high
, cmp
;
1897 mid
= (low
+ high
) / 2;
1898 cmp
= strcmp (table
[mid
].name
, s
);
1912 /* Return a numeric representation for font name field
1913 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1914 has DIM entries. Value is the numeric value found or DFLT if no
1915 table entry matches. This function is used to translate weight,
1916 slant, and swidth names of XLFD font names to numeric values. */
1919 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1920 struct table_entry
*table
;
1922 struct font_name
*font
;
1926 struct table_entry
*p
;
1927 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1928 return p
? p
->numeric
: dflt
;
1932 /* Return a symbolic representation for font name field
1933 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1934 has DIM entries. Value is the symbolic value found or DFLT if no
1935 table entry matches. This function is used to translate weight,
1936 slant, and swidth names of XLFD font names to symbols. */
1938 static INLINE Lisp_Object
1939 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1940 struct table_entry
*table
;
1942 struct font_name
*font
;
1946 struct table_entry
*p
;
1947 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1948 return p
? *p
->symbol
: dflt
;
1952 /* Return a numeric value for the slant of the font given by FONT. */
1955 xlfd_numeric_slant (font
)
1956 struct font_name
*font
;
1958 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1959 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1963 /* Return a symbol representing the weight of the font given by FONT. */
1965 static INLINE Lisp_Object
1966 xlfd_symbolic_slant (font
)
1967 struct font_name
*font
;
1969 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1970 font
, XLFD_SLANT
, Qnormal
);
1974 /* Return a numeric value for the weight of the font given by FONT. */
1977 xlfd_numeric_weight (font
)
1978 struct font_name
*font
;
1980 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1981 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1985 /* Return a symbol representing the slant of the font given by FONT. */
1987 static INLINE Lisp_Object
1988 xlfd_symbolic_weight (font
)
1989 struct font_name
*font
;
1991 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1992 font
, XLFD_WEIGHT
, Qnormal
);
1996 /* Return a numeric value for the swidth of the font whose XLFD font
1997 name fields are found in FONT. */
2000 xlfd_numeric_swidth (font
)
2001 struct font_name
*font
;
2003 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2004 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2008 /* Return a symbolic value for the swidth of FONT. */
2010 static INLINE Lisp_Object
2011 xlfd_symbolic_swidth (font
)
2012 struct font_name
*font
;
2014 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2015 font
, XLFD_SWIDTH
, Qnormal
);
2019 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2020 entries. Value is a pointer to the matching table entry or null if
2021 no element of TABLE contains SYMBOL. */
2023 static struct table_entry
*
2024 face_value (table
, dim
, symbol
)
2025 struct table_entry
*table
;
2031 xassert (SYMBOLP (symbol
));
2033 for (i
= 0; i
< dim
; ++i
)
2034 if (EQ (*table
[i
].symbol
, symbol
))
2037 return i
< dim
? table
+ i
: NULL
;
2041 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2042 entries. Value is -1 if SYMBOL is not found in TABLE. */
2045 face_numeric_value (table
, dim
, symbol
)
2046 struct table_entry
*table
;
2050 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2051 return p
? p
->numeric
: -1;
2055 /* Return a numeric value representing the weight specified by Lisp
2056 symbol WEIGHT. Value is one of the enumerators of enum
2060 face_numeric_weight (weight
)
2063 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2067 /* Return a numeric value representing the slant specified by Lisp
2068 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2071 face_numeric_slant (slant
)
2074 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2078 /* Return a numeric value representing the swidth specified by Lisp
2079 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2082 face_numeric_swidth (width
)
2085 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2089 #ifdef HAVE_WINDOW_SYSTEM
2091 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2095 struct font_name
*font
;
2097 /* Function split_font_name converts fields to lower-case, so there
2098 is no need to use tolower here. */
2099 return *font
->fields
[XLFD_SPACING
] != 'p';
2103 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2105 The actual height of the font when displayed on F depends on the
2106 resolution of both the font and frame. For example, a 10pt font
2107 designed for a 100dpi display will display larger than 10pt on a
2108 75dpi display. (It's not unusual to use fonts not designed for the
2109 display one is using. For example, some intlfonts are available in
2110 72dpi versions, only.)
2112 Value is the real point size of FONT on frame F, or 0 if it cannot
2116 xlfd_point_size (f
, font
)
2118 struct font_name
*font
;
2120 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2121 double font_pixel
= atoi (font
->fields
[XLFD_PIXEL_SIZE
]);
2124 if (font_pixel
== 0)
2127 real_pt
= PT_PER_INCH
* 10.0 * font_pixel
/ resy
+ 0.5;
2133 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2134 of frame F. This function is used to guess a point size of font
2135 when only the pixel height of the font is available. */
2138 pixel_point_size (f
, pixel
)
2142 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2146 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2147 point size of one dot. */
2148 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2149 int_pt
= real_pt
+ 0.5;
2155 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2156 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2157 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2158 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2159 zero if the font name doesn't have the format we expect. The
2160 expected format is a font name that starts with a `-' and has
2161 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2162 forms of font names where certain field contents are enclosed in
2163 square brackets. We don't support that, for now. */
2166 split_font_name (f
, font
, numeric_p
)
2168 struct font_name
*font
;
2174 if (*font
->name
== '-')
2176 char *p
= xstrlwr (font
->name
) + 1;
2178 while (i
< XLFD_LAST
)
2180 font
->fields
[i
] = p
;
2183 while (*p
&& *p
!= '-')
2193 success_p
= i
== XLFD_LAST
;
2195 /* If requested, and font name was in the expected format,
2196 compute numeric values for some fields. */
2197 if (numeric_p
&& success_p
)
2199 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2200 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2201 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2202 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2203 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2204 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2207 /* Initialize it to zero. It will be overridden by font_list while
2208 trying alternate registries. */
2209 font
->registry_priority
= 0;
2215 /* Build an XLFD font name from font name fields in FONT. Value is a
2216 pointer to the font name, which is allocated via xmalloc. */
2219 build_font_name (font
)
2220 struct font_name
*font
;
2224 char *font_name
= (char *) xmalloc (size
);
2225 int total_length
= 0;
2227 for (i
= 0; i
< XLFD_LAST
; ++i
)
2229 /* Add 1 because of the leading `-'. */
2230 int len
= strlen (font
->fields
[i
]) + 1;
2232 /* Reallocate font_name if necessary. Add 1 for the final
2234 if (total_length
+ len
+ 1 >= size
)
2236 int new_size
= max (2 * size
, size
+ len
+ 1);
2237 int sz
= new_size
* sizeof *font_name
;
2238 font_name
= (char *) xrealloc (font_name
, sz
);
2242 font_name
[total_length
] = '-';
2243 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2244 total_length
+= len
;
2247 font_name
[total_length
] = 0;
2252 /* Free an array FONTS of N font_name structures. This frees FONTS
2253 itself and all `name' fields in its elements. */
2256 free_font_names (fonts
, n
)
2257 struct font_name
*fonts
;
2261 xfree (fonts
[--n
].name
);
2266 /* Sort vector FONTS of font_name structures which contains NFONTS
2267 elements using qsort and comparison function CMPFN. F is the frame
2268 on which the fonts will be used. The global variable font_frame
2269 is temporarily set to F to make it available in CMPFN. */
2272 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2274 struct font_name
*fonts
;
2276 int (*cmpfn
) P_ ((const void *, const void *));
2279 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2284 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2285 display in x_display_list. FONTS is a pointer to a vector of
2286 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2287 alternative patterns from Valternate_fontname_alist if no fonts are
2288 found matching PATTERN.
2290 For all fonts found, set FONTS[i].name to the name of the font,
2291 allocated via xmalloc, and split font names into fields. Ignore
2292 fonts that we can't parse. Value is the number of fonts found. */
2295 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2298 struct font_name
*fonts
;
2299 int nfonts
, try_alternatives_p
;
2303 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2304 better to do it the other way around. */
2306 Lisp_Object lpattern
, tem
;
2308 lpattern
= build_string (pattern
);
2310 /* Get the list of fonts matching PATTERN. */
2313 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2316 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2319 /* Make a copy of the font names we got from X, and
2320 split them into fields. */
2322 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2324 Lisp_Object elt
, tail
;
2325 char *name
= XSTRING (XCAR (tem
))->data
;
2327 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2328 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2332 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2341 /* Make a copy of the font name. */
2342 fonts
[n
].name
= xstrdup (name
);
2344 if (split_font_name (f
, fonts
+ n
, 1))
2346 if (font_scalable_p (fonts
+ n
)
2347 && !may_use_scalable_font_p (name
))
2350 xfree (fonts
[n
].name
);
2356 xfree (fonts
[n
].name
);
2359 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2360 if (n
== 0 && try_alternatives_p
)
2362 Lisp_Object list
= Valternate_fontname_alist
;
2364 while (CONSP (list
))
2366 Lisp_Object entry
= XCAR (list
);
2368 && STRINGP (XCAR (entry
))
2369 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2376 Lisp_Object patterns
= XCAR (list
);
2379 while (CONSP (patterns
)
2380 /* If list is screwed up, give up. */
2381 && (name
= XCAR (patterns
),
2383 /* Ignore patterns equal to PATTERN because we tried that
2384 already with no success. */
2385 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2386 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2389 patterns
= XCDR (patterns
);
2397 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2398 using comparison function CMPFN. Value is the number of fonts
2399 found. If value is non-zero, *FONTS is set to a vector of
2400 font_name structures allocated from the heap containing matching
2401 fonts. Each element of *FONTS contains a name member that is also
2402 allocated from the heap. Font names in these structures are split
2403 into fields. Use free_font_names to free such an array. */
2406 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2409 int (*cmpfn
) P_ ((const void *, const void *));
2410 struct font_name
**fonts
;
2414 /* Get the list of fonts matching pattern. 100 should suffice. */
2415 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2416 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2417 nfonts
= XFASTINT (Vfont_list_limit
);
2419 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2420 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2422 /* Sort the resulting array and return it in *FONTS. If no
2423 fonts were found, make sure to set *FONTS to null. */
2425 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2436 /* Compare two font_name structures *A and *B. Value is analogous to
2437 strcmp. Sort order is given by the global variable
2438 font_sort_order. Font names are sorted so that, everything else
2439 being equal, fonts with a resolution closer to that of the frame on
2440 which they are used are listed first. The global variable
2441 font_frame is the frame on which we operate. */
2444 cmp_font_names (a
, b
)
2447 struct font_name
*x
= (struct font_name
*) a
;
2448 struct font_name
*y
= (struct font_name
*) b
;
2451 /* All strings have been converted to lower-case by split_font_name,
2452 so we can use strcmp here. */
2453 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2458 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2460 int j
= font_sort_order
[i
];
2461 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2466 /* Everything else being equal, we prefer fonts with an
2467 y-resolution closer to that of the frame. */
2468 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2469 int x_resy
= x
->numeric
[XLFD_RESY
];
2470 int y_resy
= y
->numeric
[XLFD_RESY
];
2471 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2479 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2480 is non-nil list fonts matching that pattern. Otherwise, if
2481 REGISTRY is non-nil return only fonts with that registry, otherwise
2482 return fonts of any registry. Set *FONTS to a vector of font_name
2483 structures allocated from the heap containing the fonts found.
2484 Value is the number of fonts found. */
2487 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2489 Lisp_Object pattern
, family
, registry
;
2490 struct font_name
**fonts
;
2492 char *pattern_str
, *family_str
, *registry_str
;
2496 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2497 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2499 pattern_str
= (char *) alloca (strlen (family_str
)
2500 + strlen (registry_str
)
2502 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2503 strcat (pattern_str
, family_str
);
2504 strcat (pattern_str
, "-*-");
2505 strcat (pattern_str
, registry_str
);
2506 if (!index (registry_str
, '-'))
2508 if (registry_str
[strlen (registry_str
) - 1] == '*')
2509 strcat (pattern_str
, "-*");
2511 strcat (pattern_str
, "*-*");
2515 pattern_str
= (char *) XSTRING (pattern
)->data
;
2517 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2521 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2522 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2523 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2526 static struct font_name
*
2527 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2528 struct font_name
*fonts1
, *fonts2
;
2529 int nfonts1
, nfonts2
;
2531 int new_nfonts
= nfonts1
+ nfonts2
;
2532 struct font_name
*new_fonts
;
2534 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2535 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2536 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2543 /* Get a sorted list of fonts of family FAMILY on frame F.
2545 If PATTERN is non-nil list fonts matching that pattern.
2547 If REGISTRY is non-nil, return fonts with that registry and the
2548 alternative registries from Vface_alternative_font_registry_alist.
2550 If REGISTRY is nil return fonts of any registry.
2552 Set *FONTS to a vector of font_name structures allocated from the
2553 heap containing the fonts found. Value is the number of fonts
2557 font_list (f
, pattern
, family
, registry
, fonts
)
2559 Lisp_Object pattern
, family
, registry
;
2560 struct font_name
**fonts
;
2562 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2564 if (!NILP (registry
)
2565 && CONSP (Vface_alternative_font_registry_alist
))
2569 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2574 for (alter
= XCDR (alter
), reg_prio
= 1;
2576 alter
= XCDR (alter
), reg_prio
++)
2577 if (STRINGP (XCAR (alter
)))
2580 struct font_name
*fonts2
;
2582 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2584 for (i
= 0; i
< nfonts2
; i
++)
2585 fonts2
[i
].registry_priority
= reg_prio
;
2586 *fonts
= (nfonts
> 0
2587 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2598 /* Remove elements from LIST whose cars are `equal'. Called from
2599 x-family-fonts and x-font-family-list to remove duplicate font
2603 remove_duplicates (list
)
2606 Lisp_Object tail
= list
;
2608 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2610 Lisp_Object next
= XCDR (tail
);
2611 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2612 XCDR (tail
) = XCDR (next
);
2619 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2620 "Return a list of available fonts of family FAMILY on FRAME.\n\
2621 If FAMILY is omitted or nil, list all families.\n\
2622 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2624 If FRAME is omitted or nil, use the selected frame.\n\
2625 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2626 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2627 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2628 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2629 width, weight and slant of the font. These symbols are the same as for\n\
2630 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2631 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2632 giving the registry and encoding of the font.\n\
2633 The result list is sorted according to the current setting of\n\
2634 the face font sort order.")
2636 Lisp_Object family
, frame
;
2638 struct frame
*f
= check_x_frame (frame
);
2639 struct font_name
*fonts
;
2642 struct gcpro gcpro1
;
2645 CHECK_STRING (family
, 1);
2649 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2650 for (i
= nfonts
- 1; i
>= 0; --i
)
2652 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2655 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2656 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2657 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2658 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2659 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2660 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2661 tem
= build_font_name (fonts
+ i
);
2662 ASET (v
, 6, build_string (tem
));
2663 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2664 fonts
[i
].fields
[XLFD_ENCODING
]);
2665 ASET (v
, 7, build_string (tem
));
2668 result
= Fcons (v
, result
);
2671 remove_duplicates (result
);
2672 free_font_names (fonts
, nfonts
);
2678 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2680 "Return a list of available font families on FRAME.\n\
2681 If FRAME is omitted or nil, use the selected frame.\n\
2682 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2683 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2688 struct frame
*f
= check_x_frame (frame
);
2690 struct font_name
*fonts
;
2692 struct gcpro gcpro1
;
2693 int count
= specpdl_ptr
- specpdl
;
2696 /* Let's consider all fonts. Increase the limit for matching
2697 fonts until we have them all. */
2700 specbind (intern ("font-list-limit"), make_number (limit
));
2701 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2703 if (nfonts
== limit
)
2705 free_font_names (fonts
, nfonts
);
2714 for (i
= nfonts
- 1; i
>= 0; --i
)
2715 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2716 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2719 remove_duplicates (result
);
2720 free_font_names (fonts
, nfonts
);
2722 return unbind_to (count
, result
);
2726 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2727 "Return a list of the names of available fonts matching PATTERN.\n\
2728 If optional arguments FACE and FRAME are specified, return only fonts\n\
2729 the same size as FACE on FRAME.\n\
2730 PATTERN is a string, perhaps with wildcard characters;\n\
2731 the * character matches any substring, and\n\
2732 the ? character matches any single character.\n\
2733 PATTERN is case-insensitive.\n\
2734 FACE is a face name--a symbol.\n\
2736 The return value is a list of strings, suitable as arguments to\n\
2739 Fonts Emacs can't use may or may not be excluded\n\
2740 even if they match PATTERN and FACE.\n\
2741 The optional fourth argument MAXIMUM sets a limit on how many\n\
2742 fonts to match. The first MAXIMUM fonts are reported.\n\
2743 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2744 occupied by a character of a font. In that case, return only fonts\n\
2745 the WIDTH times as wide as FACE on FRAME.")
2746 (pattern
, face
, frame
, maximum
, width
)
2747 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2754 CHECK_STRING (pattern
, 0);
2760 CHECK_NATNUM (maximum
, 0);
2761 maxnames
= XINT (maximum
);
2765 CHECK_NUMBER (width
, 4);
2767 /* We can't simply call check_x_frame because this function may be
2768 called before any frame is created. */
2769 f
= frame_or_selected_frame (frame
, 2);
2770 if (!FRAME_WINDOW_P (f
))
2772 /* Perhaps we have not yet created any frame. */
2777 /* Determine the width standard for comparison with the fonts we find. */
2783 /* This is of limited utility since it works with character
2784 widths. Keep it for compatibility. --gerd. */
2785 int face_id
= lookup_named_face (f
, face
, 0);
2786 struct face
*face
= (face_id
< 0
2788 : FACE_FROM_ID (f
, face_id
));
2790 if (face
&& face
->font
)
2791 size
= FONT_WIDTH (face
->font
);
2793 size
= FONT_WIDTH (FRAME_FONT (f
));
2796 size
*= XINT (width
);
2800 Lisp_Object args
[2];
2802 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2804 /* We don't have to check fontsets. */
2806 args
[1] = list_fontsets (f
, pattern
, size
);
2807 return Fnconc (2, args
);
2811 #endif /* HAVE_WINDOW_SYSTEM */
2815 /***********************************************************************
2817 ***********************************************************************/
2819 /* Access face attributes of face LFACE, a Lisp vector. */
2821 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2822 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2823 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2824 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2825 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2826 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2827 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2828 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2829 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2830 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2831 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2832 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2833 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2834 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2835 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2836 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2838 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2839 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2841 #define LFACEP(LFACE) \
2843 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2844 && EQ (AREF (LFACE, 0), Qface))
2849 /* Check consistency of Lisp face attribute vector ATTRS. */
2852 check_lface_attrs (attrs
)
2855 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2856 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2857 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2858 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2859 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2860 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2861 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2862 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2863 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2864 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2865 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2866 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2867 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2868 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2869 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2870 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2871 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2872 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2873 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2874 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2875 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2876 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2877 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2878 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2879 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2880 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2881 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2882 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2883 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2884 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2885 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2886 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2887 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2888 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2889 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2890 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2891 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2892 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2893 #ifdef HAVE_WINDOW_SYSTEM
2894 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2895 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2896 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2897 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2898 || NILP (attrs
[LFACE_FONT_INDEX
])
2899 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2904 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2912 xassert (LFACEP (lface
));
2913 check_lface_attrs (XVECTOR (lface
)->contents
);
2917 #else /* GLYPH_DEBUG == 0 */
2919 #define check_lface_attrs(attrs) (void) 0
2920 #define check_lface(lface) (void) 0
2922 #endif /* GLYPH_DEBUG == 0 */
2925 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2926 to make it a symvol. If FACE_NAME is an alias for another face,
2927 return that face's name. */
2930 resolve_face_name (face_name
)
2931 Lisp_Object face_name
;
2933 Lisp_Object aliased
;
2935 if (STRINGP (face_name
))
2936 face_name
= intern (XSTRING (face_name
)->data
);
2938 while (SYMBOLP (face_name
))
2940 aliased
= Fget (face_name
, Qface_alias
);
2944 face_name
= aliased
;
2951 /* Return the face definition of FACE_NAME on frame F. F null means
2952 return the definition for new frames. FACE_NAME may be a string or
2953 a symbol (apparently Emacs 20.2 allowed strings as face names in
2954 face text properties; Ediff uses that). If FACE_NAME is an alias
2955 for another face, return that face's definition. If SIGNAL_P is
2956 non-zero, signal an error if FACE_NAME is not a valid face name.
2957 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2960 static INLINE Lisp_Object
2961 lface_from_face_name (f
, face_name
, signal_p
)
2963 Lisp_Object face_name
;
2968 face_name
= resolve_face_name (face_name
);
2971 lface
= assq_no_quit (face_name
, f
->face_alist
);
2973 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2976 lface
= XCDR (lface
);
2978 signal_error ("Invalid face", face_name
);
2980 check_lface (lface
);
2985 /* Get face attributes of face FACE_NAME from frame-local faces on
2986 frame F. Store the resulting attributes in ATTRS which must point
2987 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2988 is non-zero, signal an error if FACE_NAME does not name a face.
2989 Otherwise, value is zero if FACE_NAME is not a face. */
2992 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2994 Lisp_Object face_name
;
3001 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3004 bcopy (XVECTOR (lface
)->contents
, attrs
,
3005 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3015 /* Non-zero if all attributes in face attribute vector ATTRS are
3016 specified, i.e. are non-nil. */
3019 lface_fully_specified_p (attrs
)
3024 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3025 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3026 && i
!= LFACE_AVGWIDTH_INDEX
)
3027 if (UNSPECIFIEDP (attrs
[i
]))
3030 return i
== LFACE_VECTOR_SIZE
;
3033 #ifdef HAVE_WINDOW_SYSTEM
3035 /* Set font-related attributes of Lisp face LFACE from the fullname of
3036 the font opened by FONTNAME. If FORCE_P is zero, set only
3037 unspecified attributes of LFACE. The exception is `font'
3038 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3040 If FONTNAME is not available on frame F,
3041 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3042 If the fullname is not in a valid XLFD format,
3043 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3044 in LFACE and return 1.
3045 Otherwise, return 1. */
3048 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3051 Lisp_Object fontname
;
3052 int force_p
, may_fail_p
;
3054 struct font_name font
;
3059 char *font_name
= XSTRING (fontname
)->data
;
3060 struct font_info
*font_info
;
3062 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3063 fontset
= fs_query_fontset (fontname
, 0);
3065 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3067 /* Check if FONT_NAME is surely available on the system. Usually
3068 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3069 returns quickly. But, even if FONT_NAME is not yet cached,
3070 caching it now is not futail because we anyway load the font
3073 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3083 font
.name
= STRDUPA (font_info
->full_name
);
3084 have_xlfd_p
= split_font_name (f
, &font
, 1);
3086 /* Set attributes only if unspecified, otherwise face defaults for
3087 new frames would never take effect. If we couldn't get a font
3088 name conforming to XLFD, set normal values. */
3090 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3095 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3096 + strlen (font
.fields
[XLFD_FOUNDRY
])
3098 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3099 font
.fields
[XLFD_FAMILY
]);
3100 val
= build_string (buffer
);
3103 val
= build_string ("*");
3104 LFACE_FAMILY (lface
) = val
;
3107 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3110 pt
= xlfd_point_size (f
, &font
);
3112 pt
= pixel_point_size (f
, font_info
->height
* 10);
3114 LFACE_HEIGHT (lface
) = make_number (pt
);
3117 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3118 LFACE_SWIDTH (lface
)
3119 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3121 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3122 LFACE_AVGWIDTH (lface
)
3124 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3127 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3128 LFACE_WEIGHT (lface
)
3129 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3131 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3133 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3135 LFACE_FONT (lface
) = fontname
;
3140 #endif /* HAVE_WINDOW_SYSTEM */
3143 /* Merges the face height FROM with the face height TO, and returns the
3144 merged height. If FROM is an invalid height, then INVALID is
3145 returned instead. FROM may be a either an absolute face height or a
3146 `relative' height, and TO must be an absolute height. The returned
3147 value is always an absolute height. GCPRO is a lisp value that will
3148 be protected from garbage-collection if this function makes a call
3152 merge_face_heights (from
, to
, invalid
, gcpro
)
3153 Lisp_Object from
, to
, invalid
, gcpro
;
3157 if (INTEGERP (from
))
3158 result
= XINT (from
);
3159 else if (NUMBERP (from
))
3160 result
= XFLOATINT (from
) * XINT (to
);
3161 #if 0 /* Probably not so useful. */
3162 else if (CONSP (from
) && CONSP (XCDR (from
)))
3164 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3166 if (INTEGERP (XCAR (XCDR (from
))))
3168 int inc
= XINT (XCAR (XCDR (from
)));
3169 if (EQ (XCAR (from
), Qminus
))
3172 result
= XFASTINT (to
);
3173 if (result
+ inc
> 0)
3174 /* Note that `underflows' don't mean FROM is invalid, so
3175 we just pin the result at TO if it would otherwise be
3182 else if (FUNCTIONP (from
))
3184 /* Call function with current height as argument.
3185 From is the new height. */
3186 Lisp_Object args
[2], height
;
3187 struct gcpro gcpro1
;
3193 height
= safe_call (2, args
);
3197 if (NUMBERP (height
))
3198 result
= XFLOATINT (height
);
3202 return make_number (result
);
3208 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3209 store the resulting attributes in TO, which must be already be
3210 completely specified and contain only absolute attributes. Every
3211 specified attribute of FROM overrides the corresponding attribute of
3212 TO; relative attributes in FROM are merged with the absolute value in
3213 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3214 face inheritance; it should be Qnil when called from other places. */
3217 merge_face_vectors (f
, from
, to
, cycle_check
)
3219 Lisp_Object
*from
, *to
;
3220 Lisp_Object cycle_check
;
3224 /* If FROM inherits from some other faces, merge their attributes into
3225 TO before merging FROM's direct attributes. Note that an :inherit
3226 attribute of `unspecified' is the same as one of nil; we never
3227 merge :inherit attributes, so nil is more correct, but lots of
3228 other code uses `unspecified' as a generic value for face attributes. */
3229 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3230 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3231 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3233 /* If TO specifies a :font attribute, and FROM specifies some
3234 font-related attribute, we need to clear TO's :font attribute
3235 (because it will be inconsistent with whatever FROM specifies, and
3236 FROM takes precedence). */
3237 if (!NILP (to
[LFACE_FONT_INDEX
])
3238 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3239 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3240 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3241 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3242 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3243 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3244 to
[LFACE_FONT_INDEX
] = Qnil
;
3246 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3247 if (!UNSPECIFIEDP (from
[i
]))
3248 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3249 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3253 /* TO is always an absolute face, which should inherit from nothing.
3254 We blindly copy the :inherit attribute above and fix it up here. */
3255 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3259 /* Checks the `cycle check' variable CHECK to see if it indicates that
3260 EL is part of a cycle; CHECK must be either Qnil or a value returned
3261 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3262 elements after which a cycle might be suspected; after that many
3263 elements, this macro begins consing in order to keep more precise
3266 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3269 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3270 the caller should make sure that's ok. */
3272 #define CYCLE_CHECK(check, el, suspicious) \
3275 : (INTEGERP (check) \
3276 ? (XFASTINT (check) < (suspicious) \
3277 ? make_number (XFASTINT (check) + 1) \
3278 : Fcons (el, Qnil)) \
3279 : (!NILP (Fmemq ((el), (check))) \
3281 : Fcons ((el), (check)))))
3284 /* Merge face attributes from the face on frame F whose name is
3285 INHERITS, into the vector of face attributes TO; INHERITS may also be
3286 a list of face names, in which case they are applied in order.
3287 CYCLE_CHECK is used to detect loops in face inheritance.
3288 Returns true if any of the inherited attributes are `font-related'. */
3291 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3293 Lisp_Object inherit
;
3295 Lisp_Object cycle_check
;
3297 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3298 /* Inherit from the named face INHERIT. */
3302 /* Make sure we're not in an inheritance loop. */
3303 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3304 if (NILP (cycle_check
))
3305 /* Cycle detected, ignore any further inheritance. */
3308 lface
= lface_from_face_name (f
, inherit
, 0);
3310 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3312 else if (CONSP (inherit
))
3313 /* Handle a list of inherited faces by calling ourselves recursively
3314 on each element. Note that we only do so for symbol elements, so
3315 it's not possible to infinitely recurse. */
3317 while (CONSP (inherit
))
3319 if (SYMBOLP (XCAR (inherit
)))
3320 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3322 /* Check for a circular inheritance list. */
3323 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3324 if (NILP (cycle_check
))
3325 /* Cycle detected. */
3328 inherit
= XCDR (inherit
);
3334 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3335 is a face property, determine the resulting face attributes on
3336 frame F, and store them in TO. PROP may be a single face
3337 specification or a list of such specifications. Each face
3338 specification can be
3340 1. A symbol or string naming a Lisp face.
3342 2. A property list of the form (KEYWORD VALUE ...) where each
3343 KEYWORD is a face attribute name, and value is an appropriate value
3346 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3347 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3348 for compatibility with 20.2.
3350 Face specifications earlier in lists take precedence over later
3354 merge_face_vector_with_property (f
, to
, prop
)
3361 Lisp_Object first
= XCAR (prop
);
3363 if (EQ (first
, Qforeground_color
)
3364 || EQ (first
, Qbackground_color
))
3366 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3367 . COLOR). COLOR must be a string. */
3368 Lisp_Object color_name
= XCDR (prop
);
3369 Lisp_Object color
= first
;
3371 if (STRINGP (color_name
))
3373 if (EQ (color
, Qforeground_color
))
3374 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3376 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3379 add_to_log ("Invalid face color", color_name
, Qnil
);
3381 else if (SYMBOLP (first
)
3382 && *XSYMBOL (first
)->name
->data
== ':')
3384 /* Assume this is the property list form. */
3385 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3387 Lisp_Object keyword
= XCAR (prop
);
3388 Lisp_Object value
= XCAR (XCDR (prop
));
3390 if (EQ (keyword
, QCfamily
))
3392 if (STRINGP (value
))
3393 to
[LFACE_FAMILY_INDEX
] = value
;
3395 add_to_log ("Invalid face font family", value
, Qnil
);
3397 else if (EQ (keyword
, QCheight
))
3399 Lisp_Object new_height
=
3400 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3403 if (NILP (new_height
))
3404 add_to_log ("Invalid face font height", value
, Qnil
);
3406 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3408 else if (EQ (keyword
, QCweight
))
3411 && face_numeric_weight (value
) >= 0)
3412 to
[LFACE_WEIGHT_INDEX
] = value
;
3414 add_to_log ("Invalid face weight", value
, Qnil
);
3416 else if (EQ (keyword
, QCslant
))
3419 && face_numeric_slant (value
) >= 0)
3420 to
[LFACE_SLANT_INDEX
] = value
;
3422 add_to_log ("Invalid face slant", value
, Qnil
);
3424 else if (EQ (keyword
, QCunderline
))
3429 to
[LFACE_UNDERLINE_INDEX
] = value
;
3431 add_to_log ("Invalid face underline", value
, Qnil
);
3433 else if (EQ (keyword
, QCoverline
))
3438 to
[LFACE_OVERLINE_INDEX
] = value
;
3440 add_to_log ("Invalid face overline", value
, Qnil
);
3442 else if (EQ (keyword
, QCstrike_through
))
3447 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3449 add_to_log ("Invalid face strike-through", value
, Qnil
);
3451 else if (EQ (keyword
, QCbox
))
3454 value
= make_number (1);
3455 if (INTEGERP (value
)
3459 to
[LFACE_BOX_INDEX
] = value
;
3461 add_to_log ("Invalid face box", value
, Qnil
);
3463 else if (EQ (keyword
, QCinverse_video
)
3464 || EQ (keyword
, QCreverse_video
))
3466 if (EQ (value
, Qt
) || NILP (value
))
3467 to
[LFACE_INVERSE_INDEX
] = value
;
3469 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3471 else if (EQ (keyword
, QCforeground
))
3473 if (STRINGP (value
))
3474 to
[LFACE_FOREGROUND_INDEX
] = value
;
3476 add_to_log ("Invalid face foreground", value
, Qnil
);
3478 else if (EQ (keyword
, QCbackground
))
3480 if (STRINGP (value
))
3481 to
[LFACE_BACKGROUND_INDEX
] = value
;
3483 add_to_log ("Invalid face background", value
, Qnil
);
3485 else if (EQ (keyword
, QCstipple
))
3487 #ifdef HAVE_X_WINDOWS
3488 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3489 if (!NILP (pixmap_p
))
3490 to
[LFACE_STIPPLE_INDEX
] = value
;
3492 add_to_log ("Invalid face stipple", value
, Qnil
);
3495 else if (EQ (keyword
, QCwidth
))
3498 && face_numeric_swidth (value
) >= 0)
3499 to
[LFACE_SWIDTH_INDEX
] = value
;
3501 add_to_log ("Invalid face width", value
, Qnil
);
3503 else if (EQ (keyword
, QCinherit
))
3505 if (SYMBOLP (value
))
3506 to
[LFACE_INHERIT_INDEX
] = value
;
3510 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3511 if (!SYMBOLP (XCAR (tail
)))
3514 to
[LFACE_INHERIT_INDEX
] = value
;
3516 add_to_log ("Invalid face inherit", value
, Qnil
);
3520 add_to_log ("Invalid attribute %s in face property",
3523 prop
= XCDR (XCDR (prop
));
3528 /* This is a list of face specs. Specifications at the
3529 beginning of the list take precedence over later
3530 specifications, so we have to merge starting with the
3531 last specification. */
3532 Lisp_Object next
= XCDR (prop
);
3534 merge_face_vector_with_property (f
, to
, next
);
3535 merge_face_vector_with_property (f
, to
, first
);
3540 /* PROP ought to be a face name. */
3541 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3543 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3545 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3550 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3551 Sinternal_make_lisp_face
, 1, 2, 0,
3552 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3553 If FACE was not known as a face before, create a new one.\n\
3554 If optional argument FRAME is specified, make a frame-local face\n\
3555 for that frame. Otherwise operate on the global face definition.\n\
3556 Value is a vector of face attributes.")
3558 Lisp_Object face
, frame
;
3560 Lisp_Object global_lface
, lface
;
3564 CHECK_SYMBOL (face
, 0);
3565 global_lface
= lface_from_face_name (NULL
, face
, 0);
3569 CHECK_LIVE_FRAME (frame
, 1);
3571 lface
= lface_from_face_name (f
, face
, 0);
3574 f
= NULL
, lface
= Qnil
;
3576 /* Add a global definition if there is none. */
3577 if (NILP (global_lface
))
3579 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3581 AREF (global_lface
, 0) = Qface
;
3582 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3583 Vface_new_frame_defaults
);
3585 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3586 face id to Lisp face is given by the vector lface_id_to_name.
3587 The mapping from Lisp face to Lisp face id is given by the
3588 property `face' of the Lisp face name. */
3589 if (next_lface_id
== lface_id_to_name_size
)
3591 int new_size
= max (50, 2 * lface_id_to_name_size
);
3592 int sz
= new_size
* sizeof *lface_id_to_name
;
3593 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3594 lface_id_to_name_size
= new_size
;
3597 lface_id_to_name
[next_lface_id
] = face
;
3598 Fput (face
, Qface
, make_number (next_lface_id
));
3602 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3603 AREF (global_lface
, i
) = Qunspecified
;
3605 /* Add a frame-local definition. */
3610 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3612 AREF (lface
, 0) = Qface
;
3613 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3616 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3617 AREF (lface
, i
) = Qunspecified
;
3620 lface
= global_lface
;
3622 xassert (LFACEP (lface
));
3623 check_lface (lface
);
3628 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3629 Sinternal_lisp_face_p
, 1, 2, 0,
3630 "Return non-nil if FACE names a face.\n\
3631 If optional second parameter FRAME is non-nil, check for the\n\
3632 existence of a frame-local face with name FACE on that frame.\n\
3633 Otherwise check for the existence of a global face.")
3635 Lisp_Object face
, frame
;
3641 CHECK_LIVE_FRAME (frame
, 1);
3642 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3645 lface
= lface_from_face_name (NULL
, face
, 0);
3651 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3652 Sinternal_copy_lisp_face
, 4, 4, 0,
3653 "Copy face FROM to TO.\n\
3654 If FRAME it t, copy the global face definition of FROM to the\n\
3655 global face definition of TO. Otherwise, copy the frame-local\n\
3656 definition of FROM on FRAME to the frame-local definition of TO\n\
3657 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3660 (from
, to
, frame
, new_frame
)
3661 Lisp_Object from
, to
, frame
, new_frame
;
3663 Lisp_Object lface
, copy
;
3665 CHECK_SYMBOL (from
, 0);
3666 CHECK_SYMBOL (to
, 1);
3667 if (NILP (new_frame
))
3672 /* Copy global definition of FROM. We don't make copies of
3673 strings etc. because 20.2 didn't do it either. */
3674 lface
= lface_from_face_name (NULL
, from
, 1);
3675 copy
= Finternal_make_lisp_face (to
, Qnil
);
3679 /* Copy frame-local definition of FROM. */
3680 CHECK_LIVE_FRAME (frame
, 2);
3681 CHECK_LIVE_FRAME (new_frame
, 3);
3682 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3683 copy
= Finternal_make_lisp_face (to
, new_frame
);
3686 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3687 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3693 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3694 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3695 "Set attribute ATTR of FACE to VALUE.\n\
3696 FRAME being a frame means change the face on that frame.\n\
3697 FRAME nil means change change the face of the selected frame.\n\
3698 FRAME t means change the default for new frames.\n\
3699 FRAME 0 means change the face on all frames, and change the default\n\
3701 (face
, attr
, value
, frame
)
3702 Lisp_Object face
, attr
, value
, frame
;
3705 Lisp_Object old_value
= Qnil
;
3706 /* Set 1 if ATTR is QCfont. */
3707 int font_attr_p
= 0;
3708 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3709 int font_related_attr_p
= 0;
3711 CHECK_SYMBOL (face
, 0);
3712 CHECK_SYMBOL (attr
, 1);
3714 face
= resolve_face_name (face
);
3716 /* If FRAME is 0, change face on all frames, and change the
3717 default for new frames. */
3718 if (INTEGERP (frame
) && XINT (frame
) == 0)
3721 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3722 FOR_EACH_FRAME (tail
, frame
)
3723 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3727 /* Set lface to the Lisp attribute vector of FACE. */
3729 lface
= lface_from_face_name (NULL
, face
, 1);
3733 frame
= selected_frame
;
3735 CHECK_LIVE_FRAME (frame
, 3);
3736 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3738 /* If a frame-local face doesn't exist yet, create one. */
3740 lface
= Finternal_make_lisp_face (face
, frame
);
3743 if (EQ (attr
, QCfamily
))
3745 if (!UNSPECIFIEDP (value
))
3747 CHECK_STRING (value
, 3);
3748 if (XSTRING (value
)->size
== 0)
3749 signal_error ("Invalid face family", value
);
3751 old_value
= LFACE_FAMILY (lface
);
3752 LFACE_FAMILY (lface
) = value
;
3753 font_related_attr_p
= 1;
3755 else if (EQ (attr
, QCheight
))
3757 if (!UNSPECIFIEDP (value
))
3760 (EQ (face
, Qdefault
) ? value
:
3761 /* The default face must have an absolute size, otherwise, we do
3762 a test merge with a random height to see if VALUE's ok. */
3763 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3765 if (!INTEGERP(test
) || XINT(test
) <= 0)
3766 signal_error ("Invalid face height", value
);
3769 old_value
= LFACE_HEIGHT (lface
);
3770 LFACE_HEIGHT (lface
) = value
;
3771 font_related_attr_p
= 1;
3773 else if (EQ (attr
, QCweight
))
3775 if (!UNSPECIFIEDP (value
))
3777 CHECK_SYMBOL (value
, 3);
3778 if (face_numeric_weight (value
) < 0)
3779 signal_error ("Invalid face weight", value
);
3781 old_value
= LFACE_WEIGHT (lface
);
3782 LFACE_WEIGHT (lface
) = value
;
3783 font_related_attr_p
= 1;
3785 else if (EQ (attr
, QCslant
))
3787 if (!UNSPECIFIEDP (value
))
3789 CHECK_SYMBOL (value
, 3);
3790 if (face_numeric_slant (value
) < 0)
3791 signal_error ("Invalid face slant", value
);
3793 old_value
= LFACE_SLANT (lface
);
3794 LFACE_SLANT (lface
) = value
;
3795 font_related_attr_p
= 1;
3797 else if (EQ (attr
, QCunderline
))
3799 if (!UNSPECIFIEDP (value
))
3800 if ((SYMBOLP (value
)
3802 && !EQ (value
, Qnil
))
3803 /* Underline color. */
3805 && XSTRING (value
)->size
== 0))
3806 signal_error ("Invalid face underline", value
);
3808 old_value
= LFACE_UNDERLINE (lface
);
3809 LFACE_UNDERLINE (lface
) = value
;
3811 else if (EQ (attr
, QCoverline
))
3813 if (!UNSPECIFIEDP (value
))
3814 if ((SYMBOLP (value
)
3816 && !EQ (value
, Qnil
))
3817 /* Overline color. */
3819 && XSTRING (value
)->size
== 0))
3820 signal_error ("Invalid face overline", value
);
3822 old_value
= LFACE_OVERLINE (lface
);
3823 LFACE_OVERLINE (lface
) = value
;
3825 else if (EQ (attr
, QCstrike_through
))
3827 if (!UNSPECIFIEDP (value
))
3828 if ((SYMBOLP (value
)
3830 && !EQ (value
, Qnil
))
3831 /* Strike-through color. */
3833 && XSTRING (value
)->size
== 0))
3834 signal_error ("Invalid face strike-through", value
);
3836 old_value
= LFACE_STRIKE_THROUGH (lface
);
3837 LFACE_STRIKE_THROUGH (lface
) = value
;
3839 else if (EQ (attr
, QCbox
))
3843 /* Allow t meaning a simple box of width 1 in foreground color
3846 value
= make_number (1);
3848 if (UNSPECIFIEDP (value
))
3850 else if (NILP (value
))
3852 else if (INTEGERP (value
))
3853 valid_p
= XINT (value
) != 0;
3854 else if (STRINGP (value
))
3855 valid_p
= XSTRING (value
)->size
> 0;
3856 else if (CONSP (value
))
3872 if (EQ (k
, QCline_width
))
3874 if (!INTEGERP (v
) || XINT (v
) == 0)
3877 else if (EQ (k
, QCcolor
))
3879 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3882 else if (EQ (k
, QCstyle
))
3884 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3891 valid_p
= NILP (tem
);
3897 signal_error ("Invalid face box", value
);
3899 old_value
= LFACE_BOX (lface
);
3900 LFACE_BOX (lface
) = value
;
3902 else if (EQ (attr
, QCinverse_video
)
3903 || EQ (attr
, QCreverse_video
))
3905 if (!UNSPECIFIEDP (value
))
3907 CHECK_SYMBOL (value
, 3);
3908 if (!EQ (value
, Qt
) && !NILP (value
))
3909 signal_error ("Invalid inverse-video face attribute value", value
);
3911 old_value
= LFACE_INVERSE (lface
);
3912 LFACE_INVERSE (lface
) = value
;
3914 else if (EQ (attr
, QCforeground
))
3916 if (!UNSPECIFIEDP (value
))
3918 /* Don't check for valid color names here because it depends
3919 on the frame (display) whether the color will be valid
3920 when the face is realized. */
3921 CHECK_STRING (value
, 3);
3922 if (XSTRING (value
)->size
== 0)
3923 signal_error ("Empty foreground color value", value
);
3925 old_value
= LFACE_FOREGROUND (lface
);
3926 LFACE_FOREGROUND (lface
) = value
;
3928 else if (EQ (attr
, QCbackground
))
3930 if (!UNSPECIFIEDP (value
))
3932 /* Don't check for valid color names here because it depends
3933 on the frame (display) whether the color will be valid
3934 when the face is realized. */
3935 CHECK_STRING (value
, 3);
3936 if (XSTRING (value
)->size
== 0)
3937 signal_error ("Empty background color value", value
);
3939 old_value
= LFACE_BACKGROUND (lface
);
3940 LFACE_BACKGROUND (lface
) = value
;
3942 else if (EQ (attr
, QCstipple
))
3944 #ifdef HAVE_X_WINDOWS
3945 if (!UNSPECIFIEDP (value
)
3947 && NILP (Fbitmap_spec_p (value
)))
3948 signal_error ("Invalid stipple attribute", value
);
3949 old_value
= LFACE_STIPPLE (lface
);
3950 LFACE_STIPPLE (lface
) = value
;
3951 #endif /* HAVE_X_WINDOWS */
3953 else if (EQ (attr
, QCwidth
))
3955 if (!UNSPECIFIEDP (value
))
3957 CHECK_SYMBOL (value
, 3);
3958 if (face_numeric_swidth (value
) < 0)
3959 signal_error ("Invalid face width", value
);
3961 old_value
= LFACE_SWIDTH (lface
);
3962 LFACE_SWIDTH (lface
) = value
;
3963 font_related_attr_p
= 1;
3965 else if (EQ (attr
, QCfont
))
3967 #ifdef HAVE_WINDOW_SYSTEM
3968 /* Set font-related attributes of the Lisp face from an
3973 CHECK_STRING (value
, 3);
3975 f
= SELECTED_FRAME ();
3977 f
= check_x_frame (frame
);
3979 /* VALUE may be a fontset name or an alias of fontset. In such
3980 a case, use the base fontset name. */
3981 tmp
= Fquery_fontset (value
, Qnil
);
3985 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3986 signal_error ("Invalid font or fontset name", value
);
3989 #endif /* HAVE_WINDOW_SYSTEM */
3991 else if (EQ (attr
, QCinherit
))
3994 if (SYMBOLP (value
))
3997 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3998 if (!SYMBOLP (XCAR (tail
)))
4001 LFACE_INHERIT (lface
) = value
;
4003 signal_error ("Invalid face inheritance", value
);
4005 else if (EQ (attr
, QCbold
))
4007 old_value
= LFACE_WEIGHT (lface
);
4008 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4009 font_related_attr_p
= 1;
4011 else if (EQ (attr
, QCitalic
))
4013 old_value
= LFACE_SLANT (lface
);
4014 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4015 font_related_attr_p
= 1;
4018 signal_error ("Invalid face attribute name", attr
);
4020 if (font_related_attr_p
4021 && !UNSPECIFIEDP (value
))
4022 /* If a font-related attribute other than QCfont is specified, the
4023 original `font' attribute nor that of default face is useless
4024 to determine a new font. Thus, we set it to nil so that font
4025 selection mechanism doesn't use it. */
4026 LFACE_FONT (lface
) = Qnil
;
4028 /* Changing a named face means that all realized faces depending on
4029 that face are invalid. Since we cannot tell which realized faces
4030 depend on the face, make sure they are all removed. This is done
4031 by incrementing face_change_count. The next call to
4032 init_iterator will then free realized faces. */
4034 && (EQ (attr
, QCfont
)
4035 || NILP (Fequal (old_value
, value
))))
4037 ++face_change_count
;
4038 ++windows_or_buffers_changed
;
4041 if (!UNSPECIFIEDP (value
)
4042 && NILP (Fequal (old_value
, value
)))
4048 if (EQ (face
, Qdefault
))
4050 #ifdef HAVE_WINDOW_SYSTEM
4051 /* Changed font-related attributes of the `default' face are
4052 reflected in changed `font' frame parameters. */
4053 if ((font_related_attr_p
|| font_attr_p
)
4054 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4055 set_font_frame_param (frame
, lface
);
4057 #endif /* HAVE_WINDOW_SYSTEM */
4059 if (EQ (attr
, QCforeground
))
4060 param
= Qforeground_color
;
4061 else if (EQ (attr
, QCbackground
))
4062 param
= Qbackground_color
;
4064 #ifdef HAVE_WINDOW_SYSTEM
4066 else if (EQ (face
, Qscroll_bar
))
4068 /* Changing the colors of `scroll-bar' sets frame parameters
4069 `scroll-bar-foreground' and `scroll-bar-background'. */
4070 if (EQ (attr
, QCforeground
))
4071 param
= Qscroll_bar_foreground
;
4072 else if (EQ (attr
, QCbackground
))
4073 param
= Qscroll_bar_background
;
4075 #endif /* not WINDOWSNT */
4076 else if (EQ (face
, Qborder
))
4078 /* Changing background color of `border' sets frame parameter
4080 if (EQ (attr
, QCbackground
))
4081 param
= Qborder_color
;
4083 else if (EQ (face
, Qcursor
))
4085 /* Changing background color of `cursor' sets frame parameter
4087 if (EQ (attr
, QCbackground
))
4088 param
= Qcursor_color
;
4090 else if (EQ (face
, Qmouse
))
4092 /* Changing background color of `mouse' sets frame parameter
4094 if (EQ (attr
, QCbackground
))
4095 param
= Qmouse_color
;
4097 #endif /* HAVE_WINDOW_SYSTEM */
4098 else if (EQ (face
, Qmenu
))
4099 ++menu_face_change_count
;
4103 /* Update `default-frame-alist', which is used for new frames. */
4105 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4108 /* Update the current frame's parameters. */
4111 cons
= XCAR (Vparam_value_alist
);
4112 XCAR (cons
) = param
;
4113 XCDR (cons
) = value
;
4114 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4122 #ifdef HAVE_WINDOW_SYSTEM
4124 /* Set the `font' frame parameter of FRAME determined from `default'
4125 face attributes LFACE. If a face or fontset name is explicitely
4126 specfied in LFACE, use it as is. Otherwise, determine a font name
4127 from the other font-related atrributes of LFACE. In that case, if
4128 there's no matching font, signals an error. */
4131 set_font_frame_param (frame
, lface
)
4132 Lisp_Object frame
, lface
;
4134 struct frame
*f
= XFRAME (frame
);
4136 if (FRAME_WINDOW_P (f
))
4138 Lisp_Object font_name
;
4141 if (STRINGP (LFACE_FONT (lface
)))
4142 font_name
= LFACE_FONT (lface
);
4145 /* Choose a font name that reflects LFACE's attributes and has
4146 the registry and encoding pattern specified in the default
4147 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4148 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4150 error ("No font matches the specified attribute");
4151 font_name
= build_string (font
);
4155 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4160 /* Update the corresponding face when frame parameter PARAM on frame F
4161 has been assigned the value NEW_VALUE. */
4164 update_face_from_frame_parameter (f
, param
, new_value
)
4166 Lisp_Object param
, new_value
;
4170 /* If there are no faces yet, give up. This is the case when called
4171 from Fx_create_frame, and we do the necessary things later in
4172 face-set-after-frame-defaults. */
4173 if (NILP (f
->face_alist
))
4176 if (EQ (param
, Qforeground_color
))
4178 lface
= lface_from_face_name (f
, Qdefault
, 1);
4179 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4180 ? new_value
: Qunspecified
);
4181 realize_basic_faces (f
);
4183 else if (EQ (param
, Qbackground_color
))
4187 /* Changing the background color might change the background
4188 mode, so that we have to load new defface specs. Call
4189 frame-update-face-colors to do that. */
4190 XSETFRAME (frame
, f
);
4191 call1 (Qframe_update_face_colors
, frame
);
4193 lface
= lface_from_face_name (f
, Qdefault
, 1);
4194 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4195 ? new_value
: Qunspecified
);
4196 realize_basic_faces (f
);
4198 if (EQ (param
, Qborder_color
))
4200 lface
= lface_from_face_name (f
, Qborder
, 1);
4201 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4202 ? new_value
: Qunspecified
);
4204 else if (EQ (param
, Qcursor_color
))
4206 lface
= lface_from_face_name (f
, Qcursor
, 1);
4207 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4208 ? new_value
: Qunspecified
);
4210 else if (EQ (param
, Qmouse_color
))
4212 lface
= lface_from_face_name (f
, Qmouse
, 1);
4213 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4214 ? new_value
: Qunspecified
);
4219 /* Get the value of X resource RESOURCE, class CLASS for the display
4220 of frame FRAME. This is here because ordinary `x-get-resource'
4221 doesn't take a frame argument. */
4223 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4224 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4225 (resource
, class, frame
)
4226 Lisp_Object resource
, class, frame
;
4228 Lisp_Object value
= Qnil
;
4231 CHECK_STRING (resource
, 0);
4232 CHECK_STRING (class, 1);
4233 CHECK_LIVE_FRAME (frame
, 2);
4235 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4236 resource
, class, Qnil
, Qnil
);
4238 #endif /* not macintosh */
4239 #endif /* not WINDOWSNT */
4244 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4245 If VALUE is "on" or "true", return t. If VALUE is "off" or
4246 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4247 error; if SIGNAL_P is zero, return 0. */
4250 face_boolean_x_resource_value (value
, signal_p
)
4254 Lisp_Object result
= make_number (0);
4256 xassert (STRINGP (value
));
4258 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4259 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4261 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4262 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4264 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4265 result
= Qunspecified
;
4267 signal_error ("Invalid face attribute value from X resource", value
);
4273 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4274 Finternal_set_lisp_face_attribute_from_resource
,
4275 Sinternal_set_lisp_face_attribute_from_resource
,
4277 (face
, attr
, value
, frame
)
4278 Lisp_Object face
, attr
, value
, frame
;
4280 CHECK_SYMBOL (face
, 0);
4281 CHECK_SYMBOL (attr
, 1);
4282 CHECK_STRING (value
, 2);
4284 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4285 value
= Qunspecified
;
4286 else if (EQ (attr
, QCheight
))
4288 value
= Fstring_to_number (value
, make_number (10));
4289 if (XINT (value
) <= 0)
4290 signal_error ("Invalid face height from X resource", value
);
4292 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4293 value
= face_boolean_x_resource_value (value
, 1);
4294 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4295 value
= intern (XSTRING (value
)->data
);
4296 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4297 value
= face_boolean_x_resource_value (value
, 1);
4298 else if (EQ (attr
, QCunderline
)
4299 || EQ (attr
, QCoverline
)
4300 || EQ (attr
, QCstrike_through
)
4301 || EQ (attr
, QCbox
))
4303 Lisp_Object boolean_value
;
4305 /* If the result of face_boolean_x_resource_value is t or nil,
4306 VALUE does NOT specify a color. */
4307 boolean_value
= face_boolean_x_resource_value (value
, 0);
4308 if (SYMBOLP (boolean_value
))
4309 value
= boolean_value
;
4312 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4315 #endif /* HAVE_WINDOW_SYSTEM */
4318 /***********************************************************************
4320 ***********************************************************************/
4322 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4324 /* Make menus on frame F appear as specified by the `menu' face. */
4327 x_update_menu_appearance (f
)
4330 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4334 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4338 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4339 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4340 char *myname
= XSTRING (Vx_resource_name
)->data
;
4343 const char *popup_path
= "popup_menu";
4345 const char *popup_path
= "menu.popup";
4348 if (STRINGP (LFACE_FOREGROUND (lface
)))
4350 sprintf (line
, "%s.%s*foreground: %s",
4352 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4353 XrmPutLineResource (&rdb
, line
);
4354 sprintf (line
, "%s.pane.menubar*foreground: %s",
4355 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4356 XrmPutLineResource (&rdb
, line
);
4360 if (STRINGP (LFACE_BACKGROUND (lface
)))
4362 sprintf (line
, "%s.%s*background: %s",
4364 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4365 XrmPutLineResource (&rdb
, line
);
4366 sprintf (line
, "%s.pane.menubar*background: %s",
4367 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4368 XrmPutLineResource (&rdb
, line
);
4373 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4374 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4375 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4376 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4377 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4378 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4381 const char *suffix
= "List";
4383 const char *suffix
= "";
4385 sprintf (line
, "%s.pane.menubar*font%s: %s",
4386 myname
, suffix
, face
->font_name
);
4387 XrmPutLineResource (&rdb
, line
);
4388 sprintf (line
, "%s.%s*font%s: %s",
4389 myname
, popup_path
, suffix
, face
->font_name
);
4390 XrmPutLineResource (&rdb
, line
);
4394 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4396 free_frame_menubar (f
);
4397 set_frame_menubar (f
, 1, 1);
4402 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4406 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4407 Sinternal_get_lisp_face_attribute
,
4409 "Return face attribute KEYWORD of face SYMBOL.\n\
4410 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4411 face attribute name, signal an error.\n\
4412 If the optional argument FRAME is given, report on face FACE in that\n\
4413 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4414 frames). If FRAME is omitted or nil, use the selected frame.")
4415 (symbol
, keyword
, frame
)
4416 Lisp_Object symbol
, keyword
, frame
;
4418 Lisp_Object lface
, value
= Qnil
;
4420 CHECK_SYMBOL (symbol
, 0);
4421 CHECK_SYMBOL (keyword
, 1);
4424 lface
= lface_from_face_name (NULL
, symbol
, 1);
4428 frame
= selected_frame
;
4429 CHECK_LIVE_FRAME (frame
, 2);
4430 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4433 if (EQ (keyword
, QCfamily
))
4434 value
= LFACE_FAMILY (lface
);
4435 else if (EQ (keyword
, QCheight
))
4436 value
= LFACE_HEIGHT (lface
);
4437 else if (EQ (keyword
, QCweight
))
4438 value
= LFACE_WEIGHT (lface
);
4439 else if (EQ (keyword
, QCslant
))
4440 value
= LFACE_SLANT (lface
);
4441 else if (EQ (keyword
, QCunderline
))
4442 value
= LFACE_UNDERLINE (lface
);
4443 else if (EQ (keyword
, QCoverline
))
4444 value
= LFACE_OVERLINE (lface
);
4445 else if (EQ (keyword
, QCstrike_through
))
4446 value
= LFACE_STRIKE_THROUGH (lface
);
4447 else if (EQ (keyword
, QCbox
))
4448 value
= LFACE_BOX (lface
);
4449 else if (EQ (keyword
, QCinverse_video
)
4450 || EQ (keyword
, QCreverse_video
))
4451 value
= LFACE_INVERSE (lface
);
4452 else if (EQ (keyword
, QCforeground
))
4453 value
= LFACE_FOREGROUND (lface
);
4454 else if (EQ (keyword
, QCbackground
))
4455 value
= LFACE_BACKGROUND (lface
);
4456 else if (EQ (keyword
, QCstipple
))
4457 value
= LFACE_STIPPLE (lface
);
4458 else if (EQ (keyword
, QCwidth
))
4459 value
= LFACE_SWIDTH (lface
);
4460 else if (EQ (keyword
, QCinherit
))
4461 value
= LFACE_INHERIT (lface
);
4462 else if (EQ (keyword
, QCfont
))
4463 value
= LFACE_FONT (lface
);
4465 signal_error ("Invalid face attribute name", keyword
);
4471 DEFUN ("internal-lisp-face-attribute-values",
4472 Finternal_lisp_face_attribute_values
,
4473 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4474 "Return a list of valid discrete values for face attribute ATTR.\n\
4475 Value is nil if ATTR doesn't have a discrete set of valid values.")
4479 Lisp_Object result
= Qnil
;
4481 CHECK_SYMBOL (attr
, 0);
4483 if (EQ (attr
, QCweight
)
4484 || EQ (attr
, QCslant
)
4485 || EQ (attr
, QCwidth
))
4487 /* Extract permissible symbols from tables. */
4488 struct table_entry
*table
;
4491 if (EQ (attr
, QCweight
))
4492 table
= weight_table
, dim
= DIM (weight_table
);
4493 else if (EQ (attr
, QCslant
))
4494 table
= slant_table
, dim
= DIM (slant_table
);
4496 table
= swidth_table
, dim
= DIM (swidth_table
);
4498 for (i
= 0; i
< dim
; ++i
)
4500 Lisp_Object symbol
= *table
[i
].symbol
;
4501 Lisp_Object tail
= result
;
4504 && !EQ (XCAR (tail
), symbol
))
4508 result
= Fcons (symbol
, result
);
4511 else if (EQ (attr
, QCunderline
))
4512 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4513 else if (EQ (attr
, QCoverline
))
4514 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4515 else if (EQ (attr
, QCstrike_through
))
4516 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4517 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4518 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4524 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4525 Sinternal_merge_in_global_face
, 2, 2, 0,
4526 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4527 Default face attributes override any local face attributes.")
4529 Lisp_Object face
, frame
;
4532 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4534 CHECK_LIVE_FRAME (frame
, 1);
4535 global_lface
= lface_from_face_name (NULL
, face
, 1);
4536 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4537 if (NILP (local_lface
))
4538 local_lface
= Finternal_make_lisp_face (face
, frame
);
4540 /* Make every specified global attribute override the local one.
4541 BEWARE!! This is only used from `face-set-after-frame-default' where
4542 the local frame is defined from default specs in `face-defface-spec'
4543 and those should be overridden by global settings. Hence the strange
4544 "global before local" priority. */
4545 lvec
= XVECTOR (local_lface
)->contents
;
4546 gvec
= XVECTOR (global_lface
)->contents
;
4547 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4548 if (! UNSPECIFIEDP (gvec
[i
]))
4555 /* The following function is implemented for compatibility with 20.2.
4556 The function is used in x-resolve-fonts when it is asked to
4557 return fonts with the same size as the font of a face. This is
4558 done in fontset.el. */
4560 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4561 "Return the font name of face FACE, or nil if it is unspecified.\n\
4562 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4563 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4564 The font default for a face is either nil, or a list\n\
4565 of the form (bold), (italic) or (bold italic).\n\
4566 If FRAME is omitted or nil, use the selected frame.")
4568 Lisp_Object face
, frame
;
4572 Lisp_Object result
= Qnil
;
4573 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4575 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4576 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4577 result
= Fcons (Qbold
, result
);
4579 if (!NILP (LFACE_SLANT (lface
))
4580 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4581 result
= Fcons (Qitalic
, result
);
4587 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4588 int face_id
= lookup_named_face (f
, face
, 0);
4589 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4590 return face
? build_string (face
->font_name
) : Qnil
;
4595 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4596 all attributes are `equal'. Tries to be fast because this function
4597 is called quite often. */
4600 lface_equal_p (v1
, v2
)
4601 Lisp_Object
*v1
, *v2
;
4605 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4607 Lisp_Object a
= v1
[i
];
4608 Lisp_Object b
= v2
[i
];
4610 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4611 and the other is specified. */
4612 equal_p
= XTYPE (a
) == XTYPE (b
);
4621 equal_p
= ((STRING_BYTES (XSTRING (a
))
4622 == STRING_BYTES (XSTRING (b
)))
4623 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4624 STRING_BYTES (XSTRING (a
))) == 0);
4633 equal_p
= !NILP (Fequal (a
, b
));
4643 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4644 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4645 "True if FACE1 and FACE2 are equal.\n\
4646 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4647 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4648 If FRAME is omitted or nil, use the selected frame.")
4649 (face1
, face2
, frame
)
4650 Lisp_Object face1
, face2
, frame
;
4654 Lisp_Object lface1
, lface2
;
4659 /* Don't use check_x_frame here because this function is called
4660 before X frames exist. At that time, if FRAME is nil,
4661 selected_frame will be used which is the frame dumped with
4662 Emacs. That frame is not an X frame. */
4663 f
= frame_or_selected_frame (frame
, 2);
4665 lface1
= lface_from_face_name (NULL
, face1
, 1);
4666 lface2
= lface_from_face_name (NULL
, face2
, 1);
4667 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4668 XVECTOR (lface2
)->contents
);
4669 return equal_p
? Qt
: Qnil
;
4673 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4674 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4675 "True if FACE has no attribute specified.\n\
4676 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4677 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4678 If FRAME is omitted or nil, use the selected frame.")
4680 Lisp_Object face
, frame
;
4687 frame
= selected_frame
;
4688 CHECK_LIVE_FRAME (frame
, 0);
4692 lface
= lface_from_face_name (NULL
, face
, 1);
4694 lface
= lface_from_face_name (f
, face
, 1);
4696 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4697 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4700 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4704 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4706 "Return an alist of frame-local faces defined on FRAME.\n\
4707 For internal use only.")
4711 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4712 return f
->face_alist
;
4716 /* Return a hash code for Lisp string STRING with case ignored. Used
4717 below in computing a hash value for a Lisp face. */
4719 static INLINE
unsigned
4720 hash_string_case_insensitive (string
)
4725 xassert (STRINGP (string
));
4726 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4727 hash
= (hash
<< 1) ^ tolower (*s
);
4732 /* Return a hash code for face attribute vector V. */
4734 static INLINE
unsigned
4738 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4739 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4740 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4741 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4742 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4743 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4744 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4748 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4749 considering charsets/registries). They do if they specify the same
4750 family, point size, weight, width, slant, and fontset. Both LFACE1
4751 and LFACE2 must be fully-specified. */
4754 lface_same_font_attributes_p (lface1
, lface2
)
4755 Lisp_Object
*lface1
, *lface2
;
4757 xassert (lface_fully_specified_p (lface1
)
4758 && lface_fully_specified_p (lface2
));
4759 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4760 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4761 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4762 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4763 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4764 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4765 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4766 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4767 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4768 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4769 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4770 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4775 /***********************************************************************
4777 ***********************************************************************/
4779 /* Allocate and return a new realized face for Lisp face attribute
4782 static struct face
*
4783 make_realized_face (attr
)
4786 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4787 bzero (face
, sizeof *face
);
4788 face
->ascii_face
= face
;
4789 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4794 /* Free realized face FACE, including its X resources. FACE may
4798 free_realized_face (f
, face
)
4804 #ifdef HAVE_WINDOW_SYSTEM
4805 if (FRAME_WINDOW_P (f
))
4807 /* Free fontset of FACE if it is ASCII face. */
4808 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4809 free_face_fontset (f
, face
);
4812 x_free_gc (f
, face
->gc
);
4816 free_face_colors (f
, face
);
4817 x_destroy_bitmap (f
, face
->stipple
);
4819 #endif /* HAVE_WINDOW_SYSTEM */
4826 /* Prepare face FACE for subsequent display on frame F. This
4827 allocated GCs if they haven't been allocated yet or have been freed
4828 by clearing the face cache. */
4831 prepare_face_for_display (f
, face
)
4835 #ifdef HAVE_WINDOW_SYSTEM
4836 xassert (FRAME_WINDOW_P (f
));
4841 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4843 xgcv
.foreground
= face
->foreground
;
4844 xgcv
.background
= face
->background
;
4845 #ifdef HAVE_X_WINDOWS
4846 xgcv
.graphics_exposures
= False
;
4848 /* The font of FACE may be null if we couldn't load it. */
4851 #ifdef HAVE_X_WINDOWS
4852 xgcv
.font
= face
->font
->fid
;
4855 xgcv
.font
= face
->font
;
4858 xgcv
.font
= face
->font
;
4864 #ifdef HAVE_X_WINDOWS
4867 xgcv
.fill_style
= FillOpaqueStippled
;
4868 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4869 mask
|= GCFillStyle
| GCStipple
;
4872 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4875 #endif /* HAVE_WINDOW_SYSTEM */
4879 /***********************************************************************
4881 ***********************************************************************/
4883 /* Return a new face cache for frame F. */
4885 static struct face_cache
*
4889 struct face_cache
*c
;
4892 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4893 bzero (c
, sizeof *c
);
4894 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4895 c
->buckets
= (struct face
**) xmalloc (size
);
4896 bzero (c
->buckets
, size
);
4898 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4904 /* Clear out all graphics contexts for all realized faces, except for
4905 the basic faces. This should be done from time to time just to avoid
4906 keeping too many graphics contexts that are no longer needed. */
4910 struct face_cache
*c
;
4912 if (c
&& FRAME_WINDOW_P (c
->f
))
4914 #ifdef HAVE_WINDOW_SYSTEM
4916 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4918 struct face
*face
= c
->faces_by_id
[i
];
4919 if (face
&& face
->gc
)
4921 x_free_gc (c
->f
, face
->gc
);
4925 #endif /* HAVE_WINDOW_SYSTEM */
4930 /* Free all realized faces in face cache C, including basic faces. C
4931 may be null. If faces are freed, make sure the frame's current
4932 matrix is marked invalid, so that a display caused by an expose
4933 event doesn't try to use faces we destroyed. */
4936 free_realized_faces (c
)
4937 struct face_cache
*c
;
4942 struct frame
*f
= c
->f
;
4944 /* We must block input here because we can't process X events
4945 safely while only some faces are freed, or when the frame's
4946 current matrix still references freed faces. */
4949 for (i
= 0; i
< c
->used
; ++i
)
4951 free_realized_face (f
, c
->faces_by_id
[i
]);
4952 c
->faces_by_id
[i
] = NULL
;
4956 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4957 bzero (c
->buckets
, size
);
4959 /* Must do a thorough redisplay the next time. Mark current
4960 matrices as invalid because they will reference faces freed
4961 above. This function is also called when a frame is
4962 destroyed. In this case, the root window of F is nil. */
4963 if (WINDOWP (f
->root_window
))
4965 clear_current_matrices (f
);
4966 ++windows_or_buffers_changed
;
4974 /* Free all faces realized for multibyte characters on frame F that
4978 free_realized_multibyte_face (f
, fontset
)
4982 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4986 /* We must block input here because we can't process X events safely
4987 while only some faces are freed, or when the frame's current
4988 matrix still references freed faces. */
4991 for (i
= 0; i
< cache
->used
; i
++)
4993 face
= cache
->faces_by_id
[i
];
4995 && face
!= face
->ascii_face
4996 && face
->fontset
== fontset
)
4998 uncache_face (cache
, face
);
4999 free_realized_face (f
, face
);
5003 /* Must do a thorough redisplay the next time. Mark current
5004 matrices as invalid because they will reference faces freed
5005 above. This function is also called when a frame is destroyed.
5006 In this case, the root window of F is nil. */
5007 if (WINDOWP (f
->root_window
))
5009 clear_current_matrices (f
);
5010 ++windows_or_buffers_changed
;
5017 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5018 This is done after attributes of a named face have been changed,
5019 because we can't tell which realized faces depend on that face. */
5022 free_all_realized_faces (frame
)
5028 FOR_EACH_FRAME (rest
, frame
)
5029 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5032 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5036 /* Free face cache C and faces in it, including their X resources. */
5040 struct face_cache
*c
;
5044 free_realized_faces (c
);
5046 xfree (c
->faces_by_id
);
5052 /* Cache realized face FACE in face cache C. HASH is the hash value
5053 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5054 collision list of the face hash table of C. This is done because
5055 otherwise lookup_face would find FACE for every character, even if
5056 faces with the same attributes but for specific characters exist. */
5059 cache_face (c
, face
, hash
)
5060 struct face_cache
*c
;
5064 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5068 if (face
->fontset
>= 0)
5070 struct face
*last
= c
->buckets
[i
];
5081 c
->buckets
[i
] = face
;
5082 face
->prev
= face
->next
= NULL
;
5088 face
->next
= c
->buckets
[i
];
5090 face
->next
->prev
= face
;
5091 c
->buckets
[i
] = face
;
5094 /* Find a free slot in C->faces_by_id and use the index of the free
5095 slot as FACE->id. */
5096 for (i
= 0; i
< c
->used
; ++i
)
5097 if (c
->faces_by_id
[i
] == NULL
)
5101 /* Maybe enlarge C->faces_by_id. */
5102 if (i
== c
->used
&& c
->used
== c
->size
)
5104 int new_size
= 2 * c
->size
;
5105 int sz
= new_size
* sizeof *c
->faces_by_id
;
5106 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5111 /* Check that FACE got a unique id. */
5116 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5117 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5123 #endif /* GLYPH_DEBUG */
5125 c
->faces_by_id
[i
] = face
;
5131 /* Remove face FACE from cache C. */
5134 uncache_face (c
, face
)
5135 struct face_cache
*c
;
5138 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5141 face
->prev
->next
= face
->next
;
5143 c
->buckets
[i
] = face
->next
;
5146 face
->next
->prev
= face
->prev
;
5148 c
->faces_by_id
[face
->id
] = NULL
;
5149 if (face
->id
== c
->used
)
5154 /* Look up a realized face with face attributes ATTR in the face cache
5155 of frame F. The face will be used to display character C. Value
5156 is the ID of the face found. If no suitable face is found, realize
5157 a new one. In that case, if C is a multibyte character, BASE_FACE
5158 is a face that has the same attributes. */
5161 lookup_face (f
, attr
, c
, base_face
)
5165 struct face
*base_face
;
5167 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5172 xassert (cache
!= NULL
);
5173 check_lface_attrs (attr
);
5175 /* Look up ATTR in the face cache. */
5176 hash
= lface_hash (attr
);
5177 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5179 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5180 if (face
->hash
== hash
5181 && (!FRAME_WINDOW_P (f
)
5182 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5183 && lface_equal_p (face
->lface
, attr
))
5186 /* If not found, realize a new face. */
5188 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5191 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5193 /* When this function is called from face_for_char (in this case, C is
5194 a multibyte character), a fontset of a face returned by
5195 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5196 C) is not sutisfied. The fontset is set for this face by
5197 face_for_char later. */
5199 if (FRAME_WINDOW_P (f
))
5200 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5202 #endif /* GLYPH_DEBUG */
5208 /* Return the face id of the realized face for named face SYMBOL on
5209 frame F suitable for displaying character C. Value is -1 if the
5210 face couldn't be determined, which might happen if the default face
5211 isn't realized and cannot be realized. */
5214 lookup_named_face (f
, symbol
, c
)
5219 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5220 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5221 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5223 if (default_face
== NULL
)
5225 if (!realize_basic_faces (f
))
5227 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5230 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5231 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5232 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5233 return lookup_face (f
, attrs
, c
, NULL
);
5237 /* Return the ID of the realized ASCII face of Lisp face with ID
5238 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5241 ascii_face_of_lisp_face (f
, lface_id
)
5247 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5249 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5250 face_id
= lookup_named_face (f
, face_name
, 0);
5259 /* Return a face for charset ASCII that is like the face with id
5260 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5261 STEPS < 0 means larger. Value is the id of the face. */
5264 smaller_face (f
, face_id
, steps
)
5268 #ifdef HAVE_WINDOW_SYSTEM
5270 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5271 int pt
, last_pt
, last_height
;
5274 struct face
*new_face
;
5276 /* If not called for an X frame, just return the original face. */
5277 if (FRAME_TERMCAP_P (f
))
5280 /* Try in increments of 1/2 pt. */
5281 delta
= steps
< 0 ? 5 : -5;
5282 steps
= abs (steps
);
5284 face
= FACE_FROM_ID (f
, face_id
);
5285 bcopy (face
->lface
, attrs
, sizeof attrs
);
5286 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5287 new_face_id
= face_id
;
5288 last_height
= FONT_HEIGHT (face
->font
);
5292 /* Give up if we cannot find a font within 10pt. */
5293 && abs (last_pt
- pt
) < 100)
5295 /* Look up a face for a slightly smaller/larger font. */
5297 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5298 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5299 new_face
= FACE_FROM_ID (f
, new_face_id
);
5301 /* If height changes, count that as one step. */
5302 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5303 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5306 last_height
= FONT_HEIGHT (new_face
->font
);
5313 #else /* not HAVE_WINDOW_SYSTEM */
5317 #endif /* not HAVE_WINDOW_SYSTEM */
5321 /* Return a face for charset ASCII that is like the face with id
5322 FACE_ID on frame F, but has height HEIGHT. */
5325 face_with_height (f
, face_id
, height
)
5330 #ifdef HAVE_WINDOW_SYSTEM
5332 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5334 if (FRAME_TERMCAP_P (f
)
5338 face
= FACE_FROM_ID (f
, face_id
);
5339 bcopy (face
->lface
, attrs
, sizeof attrs
);
5340 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5341 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5342 #endif /* HAVE_WINDOW_SYSTEM */
5348 /* Return the face id of the realized face for named face SYMBOL on
5349 frame F suitable for displaying character C, and use attributes of
5350 the face FACE_ID for attributes that aren't completely specified by
5351 SYMBOL. This is like lookup_named_face, except that the default
5352 attributes come from FACE_ID, not from the default face. FACE_ID
5353 is assumed to be already realized. */
5356 lookup_derived_face (f
, symbol
, c
, face_id
)
5362 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5363 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5364 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5369 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5370 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5371 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5372 return lookup_face (f
, attrs
, c
, default_face
);
5377 /***********************************************************************
5379 ***********************************************************************/
5381 DEFUN ("internal-set-font-selection-order",
5382 Finternal_set_font_selection_order
,
5383 Sinternal_set_font_selection_order
, 1, 1, 0,
5384 "Set font selection order for face font selection to ORDER.\n\
5385 ORDER must be a list of length 4 containing the symbols `:width',\n\
5386 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5387 first in ORDER are matched first, e.g. if `:height' appears before\n\
5388 `:weight' in ORDER, font selection first tries to find a font with\n\
5389 a suitable height, and then tries to match the font weight.\n\
5396 int indices
[DIM (font_sort_order
)];
5398 CHECK_LIST (order
, 0);
5399 bzero (indices
, sizeof indices
);
5403 CONSP (list
) && i
< DIM (indices
);
5404 list
= XCDR (list
), ++i
)
5406 Lisp_Object attr
= XCAR (list
);
5409 if (EQ (attr
, QCwidth
))
5411 else if (EQ (attr
, QCheight
))
5412 xlfd
= XLFD_POINT_SIZE
;
5413 else if (EQ (attr
, QCweight
))
5415 else if (EQ (attr
, QCslant
))
5420 if (indices
[i
] != 0)
5425 if (!NILP (list
) || i
!= DIM (indices
))
5426 signal_error ("Invalid font sort order", order
);
5427 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5428 if (indices
[i
] == 0)
5429 signal_error ("Invalid font sort order", order
);
5431 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5433 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5434 free_all_realized_faces (Qnil
);
5441 DEFUN ("internal-set-alternative-font-family-alist",
5442 Finternal_set_alternative_font_family_alist
,
5443 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5444 "Define alternative font families to try in face font selection.\n\
5445 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5446 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5447 be found. Value is ALIST.")
5451 CHECK_LIST (alist
, 0);
5452 Vface_alternative_font_family_alist
= alist
;
5453 free_all_realized_faces (Qnil
);
5458 DEFUN ("internal-set-alternative-font-registry-alist",
5459 Finternal_set_alternative_font_registry_alist
,
5460 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5461 "Define alternative font registries to try in face font selection.\n\
5462 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5463 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5464 be found. Value is ALIST.")
5468 CHECK_LIST (alist
, 0);
5469 Vface_alternative_font_registry_alist
= alist
;
5470 free_all_realized_faces (Qnil
);
5475 #ifdef HAVE_WINDOW_SYSTEM
5477 /* Value is non-zero if FONT is the name of a scalable font. The
5478 X11R6 XLFD spec says that point size, pixel size, and average width
5479 are zero for scalable fonts. Intlfonts contain at least one
5480 scalable font ("*-muleindian-1") for which this isn't true, so we
5481 just test average width. */
5484 font_scalable_p (font
)
5485 struct font_name
*font
;
5487 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5488 return (*s
== '0' && *(s
+ 1) == '\0')
5490 /* Windows implementation of XLFD is slightly broken for backward
5491 compatibility with previous broken versions, so test for
5492 wildcards as well as 0. */
5499 /* Ignore the difference of font point size less than this value. */
5501 #define FONT_POINT_SIZE_QUANTUM 5
5503 /* Value is non-zero if FONT1 is a better match for font attributes
5504 VALUES than FONT2. VALUES is an array of face attribute values in
5505 font sort order. COMPARE_PT_P zero means don't compare point
5506 sizes. AVGWIDTH, if not zero, is a specified font average width
5510 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5512 struct font_name
*font1
, *font2
;
5513 int compare_pt_p
, avgwidth
;
5517 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5519 int xlfd_idx
= font_sort_order
[i
];
5521 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5523 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5524 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5526 if (xlfd_idx
== XLFD_POINT_SIZE
5527 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5529 if (delta1
> delta2
)
5531 else if (delta1
< delta2
)
5535 /* The difference may be equal because, e.g., the face
5536 specifies `italic' but we have only `regular' and
5537 `oblique'. Prefer `oblique' in this case. */
5538 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5539 && font1
->numeric
[xlfd_idx
] > values
[i
]
5540 && font2
->numeric
[xlfd_idx
] < values
[i
])
5548 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5549 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5550 if (delta1
> delta2
)
5552 else if (delta1
< delta2
)
5556 return font1
->registry_priority
< font2
->registry_priority
;
5560 /* Value is non-zero if FONT is an exact match for face attributes in
5561 SPECIFIED. SPECIFIED is an array of face attribute values in font
5562 sort order. AVGWIDTH, if non-zero, is an average width to compare
5566 exact_face_match_p (specified
, font
, avgwidth
)
5568 struct font_name
*font
;
5573 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5574 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5577 return (i
== DIM (font_sort_order
)
5579 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5583 /* Value is the name of a scaled font, generated from scalable font
5584 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5585 Value is allocated from heap. */
5588 build_scalable_font_name (f
, font
, specified_pt
)
5590 struct font_name
*font
;
5593 char point_size
[20], pixel_size
[20];
5595 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5598 /* If scalable font is for a specific resolution, compute
5599 the point size we must specify from the resolution of
5600 the display and the specified resolution of the font. */
5601 if (font
->numeric
[XLFD_RESY
] != 0)
5603 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5604 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5609 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5612 /* Set point size of the font. */
5613 sprintf (point_size
, "%d", (int) pt
);
5614 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5615 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5617 /* Set pixel size. */
5618 sprintf (pixel_size
, "%d", pixel_value
);
5619 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5620 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5622 /* If font doesn't specify its resolution, use the
5623 resolution of the display. */
5624 if (font
->numeric
[XLFD_RESY
] == 0)
5627 sprintf (buffer
, "%d", (int) resy
);
5628 font
->fields
[XLFD_RESY
] = buffer
;
5629 font
->numeric
[XLFD_RESY
] = resy
;
5632 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5635 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5636 sprintf (buffer
, "%d", resx
);
5637 font
->fields
[XLFD_RESX
] = buffer
;
5638 font
->numeric
[XLFD_RESX
] = resx
;
5641 return build_font_name (font
);
5645 /* Value is non-zero if we are allowed to use scalable font FONT. We
5646 can't run a Lisp function here since this function may be called
5647 with input blocked. */
5650 may_use_scalable_font_p (font
)
5653 if (EQ (Vscalable_fonts_allowed
, Qt
))
5655 else if (CONSP (Vscalable_fonts_allowed
))
5657 Lisp_Object tail
, regexp
;
5659 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5661 regexp
= XCAR (tail
);
5662 if (STRINGP (regexp
)
5663 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5673 /* Return the name of the best matching font for face attributes ATTRS
5674 in the array of font_name structures FONTS which contains NFONTS
5675 elements. WIDTH_RATIO is a factor with which to multiply average
5676 widths if ATTRS specifies such a width.
5678 Value is a font name which is allocated from the heap. FONTS is
5679 freed by this function. */
5682 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5685 struct font_name
*fonts
;
5690 struct font_name
*best
;
5693 int exact_p
, avgwidth
;
5698 /* Make specified font attributes available in `specified',
5699 indexed by sort order. */
5700 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5702 int xlfd_idx
= font_sort_order
[i
];
5704 if (xlfd_idx
== XLFD_SWIDTH
)
5705 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5706 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5707 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5708 else if (xlfd_idx
== XLFD_WEIGHT
)
5709 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5710 else if (xlfd_idx
== XLFD_SLANT
)
5711 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5716 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5718 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5722 /* Start with the first non-scalable font in the list. */
5723 for (i
= 0; i
< nfonts
; ++i
)
5724 if (!font_scalable_p (fonts
+ i
))
5727 /* Find the best match among the non-scalable fonts. */
5732 for (i
= 1; i
< nfonts
; ++i
)
5733 if (!font_scalable_p (fonts
+ i
)
5734 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5738 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5747 /* Unless we found an exact match among non-scalable fonts, see if
5748 we can find a better match among scalable fonts. */
5751 /* A scalable font is better if
5753 1. its weight, slant, swidth attributes are better, or.
5755 2. the best non-scalable font doesn't have the required
5756 point size, and the scalable fonts weight, slant, swidth
5759 int non_scalable_has_exact_height_p
;
5761 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5762 non_scalable_has_exact_height_p
= 1;
5764 non_scalable_has_exact_height_p
= 0;
5766 for (i
= 0; i
< nfonts
; ++i
)
5767 if (font_scalable_p (fonts
+ i
))
5770 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5771 || (!non_scalable_has_exact_height_p
5772 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5777 if (font_scalable_p (best
))
5778 font_name
= build_scalable_font_name (f
, best
, pt
);
5780 font_name
= build_font_name (best
);
5782 /* Free font_name structures. */
5783 free_font_names (fonts
, nfonts
);
5789 /* Get a list of matching fonts on frame F.
5791 FAMILY, if a string, specifies a font family. If nil, use
5792 the family specified in Lisp face attributes ATTRS instead.
5794 REGISTRY, if a string, specifies a font registry and encoding to
5795 match. A value of nil means include fonts of any registry and
5798 Return in *FONTS a pointer to a vector of font_name structures for
5799 the fonts matched. Value is the number of fonts found. */
5802 try_font_list (f
, attrs
, family
, registry
, fonts
)
5805 Lisp_Object family
, registry
;
5806 struct font_name
**fonts
;
5810 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5811 family
= attrs
[LFACE_FAMILY_INDEX
];
5813 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5814 if (nfonts
== 0 && !NILP (family
))
5818 /* Try alternative font families. */
5819 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5821 for (alter
= XCDR (alter
);
5822 CONSP (alter
) && nfonts
== 0;
5823 alter
= XCDR (alter
))
5825 if (STRINGP (XCAR (alter
)))
5826 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5829 /* Try font family of the default face or "fixed". */
5832 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5834 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5836 family
= build_string ("fixed");
5837 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5840 /* Try any family with the given registry. */
5842 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5849 /* Return the fontset id of the base fontset name or alias name given
5850 by the fontset attribute of ATTRS. Value is -1 if the fontset
5851 attribute of ATTRS doesn't name a fontset. */
5854 face_fontset (attrs
)
5859 name
= attrs
[LFACE_FONT_INDEX
];
5860 if (!STRINGP (name
))
5862 return fs_query_fontset (name
, 0);
5866 /* Choose a name of font to use on frame F to display character C with
5867 Lisp face attributes specified by ATTRS. The font name is
5868 determined by the font-related attributes in ATTRS and the name
5869 pattern for C in FONTSET. Value is the font name which is
5870 allocated from the heap and must be freed by the caller, or NULL if
5871 we can get no information about the font name of C. It is assured
5872 that we always get some information for a single byte
5876 choose_face_font (f
, attrs
, fontset
, c
)
5881 Lisp_Object pattern
;
5882 char *font_name
= NULL
;
5883 struct font_name
*fonts
;
5884 int nfonts
, width_ratio
;
5886 /* Get (foundry and) family name and registry (and encoding) name of
5888 pattern
= fontset_font_pattern (f
, fontset
, c
);
5891 xassert (!SINGLE_BYTE_CHAR_P (c
));
5894 /* If what we got is a name pattern, return it. */
5895 if (STRINGP (pattern
))
5896 return xstrdup (XSTRING (pattern
)->data
);
5898 /* Family name may be specified both in ATTRS and car part of
5899 PATTERN. The former has higher priority if C is a single byte
5901 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5902 && SINGLE_BYTE_CHAR_P (c
))
5903 XCAR (pattern
) = Qnil
;
5905 /* Get a list of fonts matching that pattern and choose the
5906 best match for the specified face attributes from it. */
5907 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
5908 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
5910 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
5911 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
5915 #endif /* HAVE_WINDOW_SYSTEM */
5919 /***********************************************************************
5921 ***********************************************************************/
5923 /* Realize basic faces on frame F. Value is zero if frame parameters
5924 of F don't contain enough information needed to realize the default
5928 realize_basic_faces (f
)
5932 int count
= BINDING_STACK_SIZE ();
5934 /* Block input there so that we won't be surprised by an X expose
5935 event, for instance without having the faces set up. */
5937 specbind (Qscalable_fonts_allowed
, Qt
);
5939 if (realize_default_face (f
))
5941 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5942 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5943 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5944 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5945 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5946 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5947 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5948 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5949 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5951 /* Reflect changes in the `menu' face in menu bars. */
5952 if (menu_face_change_count
)
5954 --menu_face_change_count
;
5955 #ifdef USE_X_TOOLKIT
5956 x_update_menu_appearance (f
);
5963 unbind_to (count
, Qnil
);
5969 /* Realize the default face on frame F. If the face is not fully
5970 specified, make it fully-specified. Attributes of the default face
5971 that are not explicitly specified are taken from frame parameters. */
5974 realize_default_face (f
)
5977 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5979 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5980 Lisp_Object frame_font
;
5983 /* If the `default' face is not yet known, create it. */
5984 lface
= lface_from_face_name (f
, Qdefault
, 0);
5988 XSETFRAME (frame
, f
);
5989 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5992 #ifdef HAVE_WINDOW_SYSTEM
5993 if (FRAME_WINDOW_P (f
))
5995 /* Set frame_font to the value of the `font' frame parameter. */
5996 frame_font
= Fassq (Qfont
, f
->param_alist
);
5997 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5998 frame_font
= XCDR (frame_font
);
5999 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6001 #endif /* HAVE_WINDOW_SYSTEM */
6003 if (!FRAME_WINDOW_P (f
))
6005 LFACE_FAMILY (lface
) = build_string ("default");
6006 LFACE_SWIDTH (lface
) = Qnormal
;
6007 LFACE_HEIGHT (lface
) = make_number (1);
6008 LFACE_WEIGHT (lface
) = Qnormal
;
6009 LFACE_SLANT (lface
) = Qnormal
;
6010 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6013 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6014 LFACE_UNDERLINE (lface
) = Qnil
;
6016 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6017 LFACE_OVERLINE (lface
) = Qnil
;
6019 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6020 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6022 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6023 LFACE_BOX (lface
) = Qnil
;
6025 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6026 LFACE_INVERSE (lface
) = Qnil
;
6028 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6030 /* This function is called so early that colors are not yet
6031 set in the frame parameter list. */
6032 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6034 if (CONSP (color
) && STRINGP (XCDR (color
)))
6035 LFACE_FOREGROUND (lface
) = XCDR (color
);
6036 else if (FRAME_WINDOW_P (f
))
6038 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6039 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6044 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6046 /* This function is called so early that colors are not yet
6047 set in the frame parameter list. */
6048 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6049 if (CONSP (color
) && STRINGP (XCDR (color
)))
6050 LFACE_BACKGROUND (lface
) = XCDR (color
);
6051 else if (FRAME_WINDOW_P (f
))
6053 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6054 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6059 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6060 LFACE_STIPPLE (lface
) = Qnil
;
6062 /* Realize the face; it must be fully-specified now. */
6063 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6064 check_lface (lface
);
6065 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6066 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6071 /* Realize basic faces other than the default face in face cache C.
6072 SYMBOL is the face name, ID is the face id the realized face must
6073 have. The default face must have been realized already. */
6076 realize_named_face (f
, symbol
, id
)
6081 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6082 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6083 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6084 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6085 struct face
*new_face
;
6087 /* The default face must exist and be fully specified. */
6088 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6089 check_lface_attrs (attrs
);
6090 xassert (lface_fully_specified_p (attrs
));
6092 /* If SYMBOL isn't know as a face, create it. */
6096 XSETFRAME (frame
, f
);
6097 lface
= Finternal_make_lisp_face (symbol
, frame
);
6100 /* Merge SYMBOL's face with the default face. */
6101 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6102 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6104 /* Realize the face. */
6105 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6109 /* Realize the fully-specified face with attributes ATTRS in face
6110 cache CACHE for character C. If C is a multibyte character,
6111 BASE_FACE is a face that has the same attributes. Otherwise,
6112 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6113 ID of face to remove before caching the new face. Value is a
6114 pointer to the newly created realized face. */
6116 static struct face
*
6117 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6118 struct face_cache
*cache
;
6121 struct face
*base_face
;
6126 /* LFACE must be fully specified. */
6127 xassert (cache
!= NULL
);
6128 check_lface_attrs (attrs
);
6130 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6132 /* Remove the former face. */
6133 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6134 uncache_face (cache
, former_face
);
6135 free_realized_face (cache
->f
, former_face
);
6138 if (FRAME_WINDOW_P (cache
->f
))
6139 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6140 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6141 face
= realize_tty_face (cache
, attrs
, c
);
6145 /* Insert the new face. */
6146 cache_face (cache
, face
, lface_hash (attrs
));
6147 #ifdef HAVE_WINDOW_SYSTEM
6148 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6149 load_face_font (cache
->f
, face
, c
);
6150 #endif /* HAVE_WINDOW_SYSTEM */
6155 /* Realize the fully-specified face with attributes ATTRS in face
6156 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6157 a multibyte character, BASE_FACE is a face that has the same
6158 attributes. Otherwise, BASE_FACE is ignored. If the new face
6159 doesn't share font with the default face, a fontname is allocated
6160 from the heap and set in `font_name' of the new face, but it is not
6161 yet loaded here. Value is a pointer to the newly created realized
6164 static struct face
*
6165 realize_x_face (cache
, attrs
, c
, base_face
)
6166 struct face_cache
*cache
;
6169 struct face
*base_face
;
6171 #ifdef HAVE_WINDOW_SYSTEM
6172 struct face
*face
, *default_face
;
6174 Lisp_Object stipple
, overline
, strike_through
, box
;
6176 xassert (FRAME_WINDOW_P (cache
->f
));
6177 xassert (SINGLE_BYTE_CHAR_P (c
)
6180 /* Allocate a new realized face. */
6181 face
= make_realized_face (attrs
);
6185 /* If C is a multibyte character, we share all face attirbutes with
6186 BASE_FACE including the realized fontset. But, we must load a
6188 if (!SINGLE_BYTE_CHAR_P (c
))
6190 bcopy (base_face
, face
, sizeof *face
);
6193 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6194 face
->foreground_defaulted_p
= 1;
6195 face
->background_defaulted_p
= 1;
6196 face
->underline_defaulted_p
= 1;
6197 face
->overline_color_defaulted_p
= 1;
6198 face
->strike_through_color_defaulted_p
= 1;
6199 face
->box_color_defaulted_p
= 1;
6201 /* to force realize_face to load font */
6206 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6208 /* Determine the font to use. Most of the time, the font will be
6209 the same as the font of the default face, so try that first. */
6210 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6212 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6213 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6215 face
->font
= default_face
->font
;
6216 face
->fontset
= default_face
->fontset
;
6217 face
->font_info_id
= default_face
->font_info_id
;
6218 face
->font_name
= default_face
->font_name
;
6219 face
->ascii_face
= face
;
6221 /* But, as we can't share the fontset, make a new realized
6222 fontset that has the same base fontset as of the default
6225 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6229 /* If the face attribute ATTRS specifies a fontset, use it as
6230 the base of a new realized fontset. Otherwise, use the same
6231 base fontset as of the default face. The base determines
6232 registry and encoding of a font. It may also determine
6233 foundry and family. The other fields of font name pattern
6234 are constructed from ATTRS. */
6235 int fontset
= face_fontset (attrs
);
6237 if ((fontset
== -1) && default_face
)
6238 fontset
= default_face
->fontset
;
6239 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6240 face
->font
= NULL
; /* to force realize_face to load font */
6243 /* Load the font if it is specified in ATTRS. This fixes
6244 changing frame font on the Mac. */
6245 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6247 struct font_info
*font_info
=
6248 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6250 face
->font
= font_info
->font
;
6255 /* Load colors, and set remaining attributes. */
6257 load_face_colors (f
, face
, attrs
);
6260 box
= attrs
[LFACE_BOX_INDEX
];
6263 /* A simple box of line width 1 drawn in color given by
6265 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6267 face
->box
= FACE_SIMPLE_BOX
;
6268 face
->box_line_width
= 1;
6270 else if (INTEGERP (box
))
6272 /* Simple box of specified line width in foreground color of the
6274 xassert (XINT (box
) != 0);
6275 face
->box
= FACE_SIMPLE_BOX
;
6276 face
->box_line_width
= XINT (box
);
6277 face
->box_color
= face
->foreground
;
6278 face
->box_color_defaulted_p
= 1;
6280 else if (CONSP (box
))
6282 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6283 being one of `raised' or `sunken'. */
6284 face
->box
= FACE_SIMPLE_BOX
;
6285 face
->box_color
= face
->foreground
;
6286 face
->box_color_defaulted_p
= 1;
6287 face
->box_line_width
= 1;
6291 Lisp_Object keyword
, value
;
6293 keyword
= XCAR (box
);
6301 if (EQ (keyword
, QCline_width
))
6303 if (INTEGERP (value
) && XINT (value
) != 0)
6304 face
->box_line_width
= XINT (value
);
6306 else if (EQ (keyword
, QCcolor
))
6308 if (STRINGP (value
))
6310 face
->box_color
= load_color (f
, face
, value
,
6312 face
->use_box_color_for_shadows_p
= 1;
6315 else if (EQ (keyword
, QCstyle
))
6317 if (EQ (value
, Qreleased_button
))
6318 face
->box
= FACE_RAISED_BOX
;
6319 else if (EQ (value
, Qpressed_button
))
6320 face
->box
= FACE_SUNKEN_BOX
;
6325 /* Text underline, overline, strike-through. */
6327 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6329 /* Use default color (same as foreground color). */
6330 face
->underline_p
= 1;
6331 face
->underline_defaulted_p
= 1;
6332 face
->underline_color
= 0;
6334 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6336 /* Use specified color. */
6337 face
->underline_p
= 1;
6338 face
->underline_defaulted_p
= 0;
6339 face
->underline_color
6340 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6341 LFACE_UNDERLINE_INDEX
);
6343 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6345 face
->underline_p
= 0;
6346 face
->underline_defaulted_p
= 0;
6347 face
->underline_color
= 0;
6350 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6351 if (STRINGP (overline
))
6353 face
->overline_color
6354 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6355 LFACE_OVERLINE_INDEX
);
6356 face
->overline_p
= 1;
6358 else if (EQ (overline
, Qt
))
6360 face
->overline_color
= face
->foreground
;
6361 face
->overline_color_defaulted_p
= 1;
6362 face
->overline_p
= 1;
6365 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6366 if (STRINGP (strike_through
))
6368 face
->strike_through_color
6369 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6370 LFACE_STRIKE_THROUGH_INDEX
);
6371 face
->strike_through_p
= 1;
6373 else if (EQ (strike_through
, Qt
))
6375 face
->strike_through_color
= face
->foreground
;
6376 face
->strike_through_color_defaulted_p
= 1;
6377 face
->strike_through_p
= 1;
6380 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6381 if (!NILP (stipple
))
6382 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6384 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6386 #endif /* HAVE_WINDOW_SYSTEM */
6390 /* Map a specified color of face FACE on frame F to a tty color index.
6391 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6392 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6393 default foreground/background colors. */
6396 map_tty_color (f
, face
, idx
, defaulted
)
6399 enum lface_attribute_index idx
;
6402 Lisp_Object frame
, color
, def
;
6403 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6404 unsigned long default_pixel
, default_other_pixel
, pixel
;
6406 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6410 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6411 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6415 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6416 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6419 XSETFRAME (frame
, f
);
6420 color
= face
->lface
[idx
];
6423 && XSTRING (color
)->size
6424 && CONSP (Vtty_defined_color_alist
)
6425 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6428 /* Associations in tty-defined-color-alist are of the form
6429 (NAME INDEX R G B). We need the INDEX part. */
6430 pixel
= XINT (XCAR (XCDR (def
)));
6433 if (pixel
== default_pixel
&& STRINGP (color
))
6435 pixel
= load_color (f
, face
, color
, idx
);
6437 #if defined (MSDOS) || defined (WINDOWSNT)
6438 /* If the foreground of the default face is the default color,
6439 use the foreground color defined by the frame. */
6441 if (FRAME_MSDOS_P (f
))
6444 if (pixel
== default_pixel
6445 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6448 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6450 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6451 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6454 else if (pixel
== default_other_pixel
)
6457 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6459 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6460 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6466 #endif /* MSDOS or WINDOWSNT */
6470 face
->foreground
= pixel
;
6472 face
->background
= pixel
;
6476 /* Realize the fully-specified face with attributes ATTRS in face
6477 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6478 pointer to the newly created realized face. */
6480 static struct face
*
6481 realize_tty_face (cache
, attrs
, c
)
6482 struct face_cache
*cache
;
6488 int face_colors_defaulted
= 0;
6489 struct frame
*f
= cache
->f
;
6491 /* Frame must be a termcap frame. */
6492 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6494 /* Allocate a new realized face. */
6495 face
= make_realized_face (attrs
);
6496 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6498 /* Map face attributes to TTY appearances. We map slant to
6499 dimmed text because we want italic text to appear differently
6500 and because dimmed text is probably used infrequently. */
6501 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6502 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6504 if (weight
> XLFD_WEIGHT_MEDIUM
)
6505 face
->tty_bold_p
= 1;
6506 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6507 face
->tty_dim_p
= 1;
6508 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6509 face
->tty_underline_p
= 1;
6510 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6511 face
->tty_reverse_p
= 1;
6513 /* Map color names to color indices. */
6514 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6515 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6517 /* Swap colors if face is inverse-video. If the colors are taken
6518 from the frame colors, they are already inverted, since the
6519 frame-creation function calls x-handle-reverse-video. */
6520 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6522 unsigned long tem
= face
->foreground
;
6523 face
->foreground
= face
->background
;
6524 face
->background
= tem
;
6527 if (tty_suppress_bold_inverse_default_colors_p
6529 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6530 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6531 face
->tty_bold_p
= 0;
6537 DEFUN ("tty-suppress-bold-inverse-default-colors",
6538 Ftty_suppress_bold_inverse_default_colors
,
6539 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6540 "Suppress/allow boldness of faces with inverse default colors.\n\
6541 SUPPRESS non-nil means suppress it.\n\
6542 This affects bold faces on TTYs whose foreground is the default background\n\
6543 color of the display and whose background is the default foreground color.\n\
6544 For such faces, the bold face attribute is ignored if this variable\n\
6547 Lisp_Object suppress
;
6549 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6550 ++face_change_count
;
6556 /***********************************************************************
6558 ***********************************************************************/
6560 /* Return the ID of the face to use to display character CH with face
6561 property PROP on frame F in current_buffer. */
6564 compute_char_face (f
, ch
, prop
)
6571 if (NILP (current_buffer
->enable_multibyte_characters
))
6576 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6577 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6581 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6582 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6583 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6584 merge_face_vector_with_property (f
, attrs
, prop
);
6585 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6592 /* Return the face ID associated with buffer position POS for
6593 displaying ASCII characters. Return in *ENDPTR the position at
6594 which a different face is needed, as far as text properties and
6595 overlays are concerned. W is a window displaying current_buffer.
6597 REGION_BEG, REGION_END delimit the region, so it can be
6600 LIMIT is a position not to scan beyond. That is to limit the time
6601 this function can take.
6603 If MOUSE is non-zero, use the character's mouse-face, not its face.
6605 The face returned is suitable for displaying ASCII characters. */
6608 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6609 endptr
, limit
, mouse
)
6612 int region_beg
, region_end
;
6617 struct frame
*f
= XFRAME (w
->frame
);
6618 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6619 Lisp_Object prop
, position
;
6621 Lisp_Object
*overlay_vec
;
6624 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6625 Lisp_Object limit1
, end
;
6626 struct face
*default_face
;
6628 /* W must display the current buffer. We could write this function
6629 to use the frame and buffer of W, but right now it doesn't. */
6630 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6632 XSETFRAME (frame
, f
);
6633 XSETFASTINT (position
, pos
);
6636 if (pos
< region_beg
&& region_beg
< endpos
)
6637 endpos
= region_beg
;
6639 /* Get the `face' or `mouse_face' text property at POS, and
6640 determine the next position at which the property changes. */
6641 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6642 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6643 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6645 endpos
= XINT (end
);
6647 /* Look at properties from overlays. */
6652 /* First try with room for 40 overlays. */
6654 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6655 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6656 &next_overlay
, NULL
, 0);
6658 /* If there are more than 40, make enough space for all, and try
6660 if (noverlays
> len
)
6663 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6664 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6665 &next_overlay
, NULL
, 0);
6668 if (next_overlay
< endpos
)
6669 endpos
= next_overlay
;
6674 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6676 /* Optimize common cases where we can use the default face. */
6679 && !(pos
>= region_beg
&& pos
< region_end
))
6680 return DEFAULT_FACE_ID
;
6682 /* Begin with attributes from the default face. */
6683 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6685 /* Merge in attributes specified via text properties. */
6687 merge_face_vector_with_property (f
, attrs
, prop
);
6689 /* Now merge the overlay data. */
6690 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6691 for (i
= 0; i
< noverlays
; i
++)
6696 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6698 merge_face_vector_with_property (f
, attrs
, prop
);
6700 oend
= OVERLAY_END (overlay_vec
[i
]);
6701 oendpos
= OVERLAY_POSITION (oend
);
6702 if (oendpos
< endpos
)
6706 /* If in the region, merge in the region face. */
6707 if (pos
>= region_beg
&& pos
< region_end
)
6709 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6710 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6712 if (region_end
< endpos
)
6713 endpos
= region_end
;
6718 /* Look up a realized face with the given face attributes,
6719 or realize a new one for ASCII characters. */
6720 return lookup_face (f
, attrs
, 0, NULL
);
6724 /* Compute the face at character position POS in Lisp string STRING on
6725 window W, for ASCII characters.
6727 If STRING is an overlay string, it comes from position BUFPOS in
6728 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6729 not an overlay string. W must display the current buffer.
6730 REGION_BEG and REGION_END give the start and end positions of the
6731 region; both are -1 if no region is visible.
6733 BASE_FACE_ID is the id of a face to merge with. For strings coming
6734 from overlays or the `display' property it is the face at BUFPOS.
6736 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6738 Set *ENDPTR to the next position where to check for faces in
6739 STRING; -1 if the face is constant from POS to the end of the
6742 Value is the id of the face to use. The face returned is suitable
6743 for displaying ASCII characters. */
6746 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6747 region_end
, endptr
, base_face_id
, mouse_p
)
6751 int region_beg
, region_end
;
6753 enum face_id base_face_id
;
6756 Lisp_Object prop
, position
, end
, limit
;
6757 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6758 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6759 struct face
*base_face
;
6760 int multibyte_p
= STRING_MULTIBYTE (string
);
6761 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6763 /* Get the value of the face property at the current position within
6764 STRING. Value is nil if there is no face property. */
6765 XSETFASTINT (position
, pos
);
6766 prop
= Fget_text_property (position
, prop_name
, string
);
6768 /* Get the next position at which to check for faces. Value of end
6769 is nil if face is constant all the way to the end of the string.
6770 Otherwise it is a string position where to check faces next.
6771 Limit is the maximum position up to which to check for property
6772 changes in Fnext_single_property_change. Strings are usually
6773 short, so set the limit to the end of the string. */
6774 XSETFASTINT (limit
, XSTRING (string
)->size
);
6775 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6777 *endptr
= XFASTINT (end
);
6781 base_face
= FACE_FROM_ID (f
, base_face_id
);
6782 xassert (base_face
);
6784 /* Optimize the default case that there is no face property and we
6785 are not in the region. */
6787 && (base_face_id
!= DEFAULT_FACE_ID
6788 /* BUFPOS <= 0 means STRING is not an overlay string, so
6789 that the region doesn't have to be taken into account. */
6791 || bufpos
< region_beg
6792 || bufpos
>= region_end
)
6794 /* We can't realize faces for different charsets differently
6795 if we don't have fonts, so we can stop here if not working
6796 on a window-system frame. */
6797 || !FRAME_WINDOW_P (f
)
6798 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6799 return base_face
->id
;
6801 /* Begin with attributes from the base face. */
6802 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6804 /* Merge in attributes specified via text properties. */
6806 merge_face_vector_with_property (f
, attrs
, prop
);
6808 /* If in the region, merge in the region face. */
6810 && bufpos
>= region_beg
6811 && bufpos
< region_end
)
6813 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6814 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6817 /* Look up a realized face with the given face attributes,
6818 or realize a new one for ASCII characters. */
6819 return lookup_face (f
, attrs
, 0, NULL
);
6824 /***********************************************************************
6826 ***********************************************************************/
6830 /* Print the contents of the realized face FACE to stderr. */
6833 dump_realized_face (face
)
6836 fprintf (stderr
, "ID: %d\n", face
->id
);
6837 #ifdef HAVE_X_WINDOWS
6838 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6840 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6842 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6843 fprintf (stderr
, "background: 0x%lx (%s)\n",
6845 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6846 fprintf (stderr
, "font_name: %s (%s)\n",
6848 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6849 #ifdef HAVE_X_WINDOWS
6850 fprintf (stderr
, "font = %p\n", face
->font
);
6852 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6853 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6854 fprintf (stderr
, "underline: %d (%s)\n",
6856 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6857 fprintf (stderr
, "hash: %d\n", face
->hash
);
6858 fprintf (stderr
, "charset: %d\n", face
->charset
);
6862 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6870 fprintf (stderr
, "font selection order: ");
6871 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6872 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6873 fprintf (stderr
, "\n");
6875 fprintf (stderr
, "alternative fonts: ");
6876 debug_print (Vface_alternative_font_family_alist
);
6877 fprintf (stderr
, "\n");
6879 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6880 Fdump_face (make_number (i
));
6885 CHECK_NUMBER (n
, 0);
6886 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6888 error ("Not a valid face");
6889 dump_realized_face (face
);
6896 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6900 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6901 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6902 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6906 #endif /* GLYPH_DEBUG != 0 */
6910 /***********************************************************************
6912 ***********************************************************************/
6917 Qface
= intern ("face");
6919 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6920 staticpro (&Qbitmap_spec_p
);
6921 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6922 staticpro (&Qframe_update_face_colors
);
6924 /* Lisp face attribute keywords. */
6925 QCfamily
= intern (":family");
6926 staticpro (&QCfamily
);
6927 QCheight
= intern (":height");
6928 staticpro (&QCheight
);
6929 QCweight
= intern (":weight");
6930 staticpro (&QCweight
);
6931 QCslant
= intern (":slant");
6932 staticpro (&QCslant
);
6933 QCunderline
= intern (":underline");
6934 staticpro (&QCunderline
);
6935 QCinverse_video
= intern (":inverse-video");
6936 staticpro (&QCinverse_video
);
6937 QCreverse_video
= intern (":reverse-video");
6938 staticpro (&QCreverse_video
);
6939 QCforeground
= intern (":foreground");
6940 staticpro (&QCforeground
);
6941 QCbackground
= intern (":background");
6942 staticpro (&QCbackground
);
6943 QCstipple
= intern (":stipple");;
6944 staticpro (&QCstipple
);
6945 QCwidth
= intern (":width");
6946 staticpro (&QCwidth
);
6947 QCfont
= intern (":font");
6948 staticpro (&QCfont
);
6949 QCbold
= intern (":bold");
6950 staticpro (&QCbold
);
6951 QCitalic
= intern (":italic");
6952 staticpro (&QCitalic
);
6953 QCoverline
= intern (":overline");
6954 staticpro (&QCoverline
);
6955 QCstrike_through
= intern (":strike-through");
6956 staticpro (&QCstrike_through
);
6957 QCbox
= intern (":box");
6959 QCinherit
= intern (":inherit");
6960 staticpro (&QCinherit
);
6962 /* Symbols used for Lisp face attribute values. */
6963 QCcolor
= intern (":color");
6964 staticpro (&QCcolor
);
6965 QCline_width
= intern (":line-width");
6966 staticpro (&QCline_width
);
6967 QCstyle
= intern (":style");
6968 staticpro (&QCstyle
);
6969 Qreleased_button
= intern ("released-button");
6970 staticpro (&Qreleased_button
);
6971 Qpressed_button
= intern ("pressed-button");
6972 staticpro (&Qpressed_button
);
6973 Qnormal
= intern ("normal");
6974 staticpro (&Qnormal
);
6975 Qultra_light
= intern ("ultra-light");
6976 staticpro (&Qultra_light
);
6977 Qextra_light
= intern ("extra-light");
6978 staticpro (&Qextra_light
);
6979 Qlight
= intern ("light");
6980 staticpro (&Qlight
);
6981 Qsemi_light
= intern ("semi-light");
6982 staticpro (&Qsemi_light
);
6983 Qsemi_bold
= intern ("semi-bold");
6984 staticpro (&Qsemi_bold
);
6985 Qbold
= intern ("bold");
6987 Qextra_bold
= intern ("extra-bold");
6988 staticpro (&Qextra_bold
);
6989 Qultra_bold
= intern ("ultra-bold");
6990 staticpro (&Qultra_bold
);
6991 Qoblique
= intern ("oblique");
6992 staticpro (&Qoblique
);
6993 Qitalic
= intern ("italic");
6994 staticpro (&Qitalic
);
6995 Qreverse_oblique
= intern ("reverse-oblique");
6996 staticpro (&Qreverse_oblique
);
6997 Qreverse_italic
= intern ("reverse-italic");
6998 staticpro (&Qreverse_italic
);
6999 Qultra_condensed
= intern ("ultra-condensed");
7000 staticpro (&Qultra_condensed
);
7001 Qextra_condensed
= intern ("extra-condensed");
7002 staticpro (&Qextra_condensed
);
7003 Qcondensed
= intern ("condensed");
7004 staticpro (&Qcondensed
);
7005 Qsemi_condensed
= intern ("semi-condensed");
7006 staticpro (&Qsemi_condensed
);
7007 Qsemi_expanded
= intern ("semi-expanded");
7008 staticpro (&Qsemi_expanded
);
7009 Qexpanded
= intern ("expanded");
7010 staticpro (&Qexpanded
);
7011 Qextra_expanded
= intern ("extra-expanded");
7012 staticpro (&Qextra_expanded
);
7013 Qultra_expanded
= intern ("ultra-expanded");
7014 staticpro (&Qultra_expanded
);
7015 Qbackground_color
= intern ("background-color");
7016 staticpro (&Qbackground_color
);
7017 Qforeground_color
= intern ("foreground-color");
7018 staticpro (&Qforeground_color
);
7019 Qunspecified
= intern ("unspecified");
7020 staticpro (&Qunspecified
);
7022 Qface_alias
= intern ("face-alias");
7023 staticpro (&Qface_alias
);
7024 Qdefault
= intern ("default");
7025 staticpro (&Qdefault
);
7026 Qtool_bar
= intern ("tool-bar");
7027 staticpro (&Qtool_bar
);
7028 Qregion
= intern ("region");
7029 staticpro (&Qregion
);
7030 Qfringe
= intern ("fringe");
7031 staticpro (&Qfringe
);
7032 Qheader_line
= intern ("header-line");
7033 staticpro (&Qheader_line
);
7034 Qscroll_bar
= intern ("scroll-bar");
7035 staticpro (&Qscroll_bar
);
7036 Qmenu
= intern ("menu");
7038 Qcursor
= intern ("cursor");
7039 staticpro (&Qcursor
);
7040 Qborder
= intern ("border");
7041 staticpro (&Qborder
);
7042 Qmouse
= intern ("mouse");
7043 staticpro (&Qmouse
);
7044 Qtty_color_desc
= intern ("tty-color-desc");
7045 staticpro (&Qtty_color_desc
);
7046 Qtty_color_by_index
= intern ("tty-color-by-index");
7047 staticpro (&Qtty_color_by_index
);
7048 Qtty_color_alist
= intern ("tty-color-alist");
7049 staticpro (&Qtty_color_alist
);
7050 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7051 staticpro (&Qscalable_fonts_allowed
);
7053 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7054 staticpro (&Vparam_value_alist
);
7055 Vface_alternative_font_family_alist
= Qnil
;
7056 staticpro (&Vface_alternative_font_family_alist
);
7057 Vface_alternative_font_registry_alist
= Qnil
;
7058 staticpro (&Vface_alternative_font_registry_alist
);
7060 defsubr (&Sinternal_make_lisp_face
);
7061 defsubr (&Sinternal_lisp_face_p
);
7062 defsubr (&Sinternal_set_lisp_face_attribute
);
7063 #ifdef HAVE_WINDOW_SYSTEM
7064 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7066 defsubr (&Scolor_gray_p
);
7067 defsubr (&Scolor_supported_p
);
7068 defsubr (&Sinternal_get_lisp_face_attribute
);
7069 defsubr (&Sinternal_lisp_face_attribute_values
);
7070 defsubr (&Sinternal_lisp_face_equal_p
);
7071 defsubr (&Sinternal_lisp_face_empty_p
);
7072 defsubr (&Sinternal_copy_lisp_face
);
7073 defsubr (&Sinternal_merge_in_global_face
);
7074 defsubr (&Sface_font
);
7075 defsubr (&Sframe_face_alist
);
7076 defsubr (&Sinternal_set_font_selection_order
);
7077 defsubr (&Sinternal_set_alternative_font_family_alist
);
7078 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7080 defsubr (&Sdump_face
);
7081 defsubr (&Sshow_face_resources
);
7082 #endif /* GLYPH_DEBUG */
7083 defsubr (&Sclear_face_cache
);
7084 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7086 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7087 defsubr (&Sdump_colors
);
7090 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7091 "*Limit for font matching.\n\
7092 If an integer > 0, font matching functions won't load more than\n\
7093 that number of fonts when searching for a matching font.");
7094 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7096 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7097 "List of global face definitions (for internal use only.)");
7098 Vface_new_frame_defaults
= Qnil
;
7100 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7101 "*Default stipple pattern used on monochrome displays.\n\
7102 This stipple pattern is used on monochrome displays\n\
7103 instead of shades of gray for a face background color.\n\
7104 See `set-face-stipple' for possible values for this variable.");
7105 Vface_default_stipple
= build_string ("gray3");
7107 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7108 "An alist of defined terminal colors and their RGB values.");
7109 Vtty_defined_color_alist
= Qnil
;
7111 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7112 "Allowed scalable fonts.\n\
7113 A value of nil means don't allow any scalable fonts.\n\
7114 A value of t means allow any scalable font.\n\
7115 Otherwise, value must be a list of regular expressions. A font may be\n\
7116 scaled if its name matches a regular expression in the list.");
7117 Vscalable_fonts_allowed
= Qt
;
7119 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7120 "List of ignored fonts.\n\
7121 Each element is a regular expression that matches names of fonts to ignore.");
7122 Vface_ignored_fonts
= Qnil
;
7124 #ifdef HAVE_WINDOW_SYSTEM
7125 defsubr (&Sbitmap_spec_p
);
7126 defsubr (&Sx_list_fonts
);
7127 defsubr (&Sinternal_face_x_get_resource
);
7128 defsubr (&Sx_family_fonts
);
7129 defsubr (&Sx_font_family_list
);
7130 #endif /* HAVE_WINDOW_SYSTEM */