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>
200 #include "keyboard.h"
203 #ifdef HAVE_WINDOW_SYSTEM
205 #endif /* HAVE_WINDOW_SYSTEM */
207 #ifdef HAVE_X_WINDOWS
211 #include <Xm/XmStrDefs.h>
212 #endif /* USE_MOTIF */
213 #endif /* HAVE_X_WINDOWS */
222 /* Redefine X specifics to W32 equivalents to avoid cluttering the
223 code with #ifdef blocks. */
224 #undef FRAME_X_DISPLAY_INFO
225 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
226 #define x_display_info w32_display_info
227 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
228 #define check_x check_w32
229 #define x_list_fonts w32_list_fonts
230 #define GCGraphicsExposures 0
231 /* For historic reasons, FONT_WIDTH refers to average width on W32,
232 not maximum as on X. Redefine here. */
234 #define FONT_WIDTH FONT_MAX_WIDTH
235 #endif /* WINDOWSNT */
239 #define x_display_info mac_display_info
240 #define check_x check_mac
244 #include "dispextern.h"
245 #include "blockinput.h"
247 #include "intervals.h"
249 #ifdef HAVE_X_WINDOWS
251 /* Compensate for a bug in Xos.h on some systems, on which it requires
252 time.h. On some such systems, Xos.h tries to redefine struct
253 timeval and struct timezone if USG is #defined while it is
256 #ifdef XOS_NEEDS_TIME_H
262 #else /* not XOS_NEEDS_TIME_H */
264 #endif /* not XOS_NEEDS_TIME_H */
266 #endif /* HAVE_X_WINDOWS */
271 #define abs(X) ((X) < 0 ? -(X) : (X))
273 /* Number of pt per inch (from the TeXbook). */
275 #define PT_PER_INCH 72.27
277 /* Non-zero if face attribute ATTR is unspecified. */
279 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
281 /* Value is the number of elements of VECTOR. */
283 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
285 /* Make a copy of string S on the stack using alloca. Value is a pointer
288 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
290 /* Make a copy of the contents of Lisp string S on the stack using
291 alloca. Value is a pointer to the copy. */
293 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
295 /* Size of hash table of realized faces in face caches (should be a
298 #define FACE_CACHE_BUCKETS_SIZE 1001
300 /* A definition of XColor for non-X frames. */
302 #ifndef HAVE_X_WINDOWS
307 unsigned short red
, green
, blue
;
313 #endif /* not HAVE_X_WINDOWS */
315 /* Keyword symbols used for face attribute names. */
317 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
318 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
319 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
320 Lisp_Object QCreverse_video
;
321 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
323 /* Symbols used for attribute values. */
325 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
326 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
327 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
328 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
329 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
330 Lisp_Object Qultra_expanded
;
331 Lisp_Object Qreleased_button
, Qpressed_button
;
332 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
333 Lisp_Object Qunspecified
;
335 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
337 /* The name of the function to call when the background of the frame
338 has changed, frame_update_face_colors. */
340 Lisp_Object Qframe_update_face_colors
;
342 /* Names of basic faces. */
344 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
345 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
346 Lisp_Object Qmode_line_inactive
;
347 extern Lisp_Object Qmode_line
;
349 /* The symbol `face-alias'. A symbols having that property is an
350 alias for another face. Value of the property is the name of
353 Lisp_Object Qface_alias
;
355 /* Names of frame parameters related to faces. */
357 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
358 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
360 /* Default stipple pattern used on monochrome displays. This stipple
361 pattern is used on monochrome displays instead of shades of gray
362 for a face background color. See `set-face-stipple' for possible
363 values for this variable. */
365 Lisp_Object Vface_default_stipple
;
367 /* Alist of alternative font families. Each element is of the form
368 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
369 try FAMILY1, then FAMILY2, ... */
371 Lisp_Object Vface_alternative_font_family_alist
;
373 /* Alist of alternative font registries. Each element is of the form
374 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
375 loaded, try REGISTRY1, then REGISTRY2, ... */
377 Lisp_Object Vface_alternative_font_registry_alist
;
379 /* Allowed scalable fonts. A value of nil means don't allow any
380 scalable fonts. A value of t means allow the use of any scalable
381 font. Otherwise, value must be a list of regular expressions. A
382 font may be scaled if its name matches a regular expression in the
385 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
387 /* List of regular expressions that matches names of fonts to ignore. */
389 Lisp_Object Vface_ignored_fonts
;
391 /* Maximum number of fonts to consider in font_list. If not an
392 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
394 Lisp_Object Vfont_list_limit
;
395 #define DEFAULT_FONT_LIST_LIMIT 100
397 /* The symbols `foreground-color' and `background-color' which can be
398 used as part of a `face' property. This is for compatibility with
401 Lisp_Object Qforeground_color
, Qbackground_color
;
403 /* The symbols `face' and `mouse-face' used as text properties. */
406 extern Lisp_Object Qmouse_face
;
408 /* Error symbol for wrong_type_argument in load_pixmap. */
410 Lisp_Object Qbitmap_spec_p
;
412 /* Alist of global face definitions. Each element is of the form
413 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
414 is a Lisp vector of face attributes. These faces are used
415 to initialize faces for new frames. */
417 Lisp_Object Vface_new_frame_defaults
;
419 /* The next ID to assign to Lisp faces. */
421 static int next_lface_id
;
423 /* A vector mapping Lisp face Id's to face names. */
425 static Lisp_Object
*lface_id_to_name
;
426 static int lface_id_to_name_size
;
428 /* TTY color-related functions (defined in tty-colors.el). */
430 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
432 /* The name of the function used to compute colors on TTYs. */
434 Lisp_Object Qtty_color_alist
;
436 /* An alist of defined terminal colors and their RGB values. */
438 Lisp_Object Vtty_defined_color_alist
;
440 /* Counter for calls to clear_face_cache. If this counter reaches
441 CLEAR_FONT_TABLE_COUNT, and a frame has more than
442 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
444 static int clear_font_table_count
;
445 #define CLEAR_FONT_TABLE_COUNT 100
446 #define CLEAR_FONT_TABLE_NFONTS 10
448 /* Non-zero means face attributes have been changed since the last
449 redisplay. Used in redisplay_internal. */
451 int face_change_count
;
453 /* Non-zero means don't display bold text if a face's foreground
454 and background colors are the inverse of the default colors of the
455 display. This is a kluge to suppress `bold black' foreground text
456 which is hard to read on an LCD monitor. */
458 int tty_suppress_bold_inverse_default_colors_p
;
460 /* A list of the form `((x . y))' used to avoid consing in
461 Finternal_set_lisp_face_attribute. */
463 static Lisp_Object Vparam_value_alist
;
465 /* The total number of colors currently allocated. */
468 static int ncolors_allocated
;
469 static int npixmaps_allocated
;
473 /* Non-zero means the definition of the `menu' face for new frames has
476 int menu_face_changed_default
;
479 /* Function prototypes. */
484 static void map_tty_color
P_ ((struct frame
*, struct face
*,
485 enum lface_attribute_index
, int *));
486 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
487 static int may_use_scalable_font_p
P_ ((char *));
488 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
489 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
491 static int x_face_list_fonts
P_ ((struct frame
*, char *,
492 struct font_name
*, int, int));
493 static int font_scalable_p
P_ ((struct font_name
*));
494 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
495 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
496 static unsigned char *xstrlwr
P_ ((unsigned char *));
497 static void signal_error
P_ ((char *, Lisp_Object
));
498 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
499 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
500 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
501 static void free_face_colors
P_ ((struct frame
*, struct face
*));
502 static int face_color_gray_p
P_ ((struct frame
*, char *));
503 static char *build_font_name
P_ ((struct font_name
*));
504 static void free_font_names
P_ ((struct font_name
*, int));
505 static int sorted_font_list
P_ ((struct frame
*, char *,
506 int (*cmpfn
) P_ ((const void *, const void *)),
507 struct font_name
**));
508 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
509 Lisp_Object
, struct font_name
**));
510 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
511 Lisp_Object
, struct font_name
**));
512 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
513 Lisp_Object
, Lisp_Object
, struct font_name
**));
514 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
515 Lisp_Object
, struct font_name
**));
516 static int cmp_font_names
P_ ((const void *, const void *));
517 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
518 struct face
*, int));
519 static struct face
*realize_x_face
P_ ((struct face_cache
*,
520 Lisp_Object
*, int, struct face
*));
521 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
522 Lisp_Object
*, int));
523 static int realize_basic_faces
P_ ((struct frame
*));
524 static int realize_default_face
P_ ((struct frame
*));
525 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
526 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
527 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
528 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
529 static unsigned lface_hash
P_ ((Lisp_Object
*));
530 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
531 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
532 static void free_realized_face
P_ ((struct frame
*, struct face
*));
533 static void clear_face_gcs
P_ ((struct face_cache
*));
534 static void free_face_cache
P_ ((struct face_cache
*));
535 static int face_numeric_weight
P_ ((Lisp_Object
));
536 static int face_numeric_slant
P_ ((Lisp_Object
));
537 static int face_numeric_swidth
P_ ((Lisp_Object
));
538 static int face_fontset
P_ ((Lisp_Object
*));
539 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
540 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
541 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
542 Lisp_Object
*, Lisp_Object
));
543 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
545 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
546 Lisp_Object
, int, int));
547 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
548 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
549 static void free_realized_faces
P_ ((struct face_cache
*));
550 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
551 struct font_name
*, int, int));
552 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
553 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
554 static int xlfd_numeric_slant
P_ ((struct font_name
*));
555 static int xlfd_numeric_weight
P_ ((struct font_name
*));
556 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
557 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
558 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
559 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
560 static int xlfd_fixed_p
P_ ((struct font_name
*));
561 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
563 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
564 struct font_name
*, int,
566 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
567 struct font_name
*, int));
569 #ifdef HAVE_WINDOW_SYSTEM
571 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
572 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
573 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
574 int (*cmpfn
) P_ ((const void *, const void *))));
575 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
576 static void x_free_gc
P_ ((struct frame
*, GC
));
577 static void clear_font_table
P_ ((struct x_display_info
*));
580 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
581 #endif /* WINDOWSNT */
584 static void x_update_menu_appearance
P_ ((struct frame
*));
586 extern void free_frame_menubar
P_ ((struct frame
*));
587 #endif /* USE_X_TOOLKIT */
589 #endif /* HAVE_WINDOW_SYSTEM */
592 /***********************************************************************
594 ***********************************************************************/
596 #ifdef HAVE_X_WINDOWS
598 #ifdef DEBUG_X_COLORS
600 /* The following is a poor mans infrastructure for debugging X color
601 allocation problems on displays with PseudoColor-8. Some X servers
602 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
603 color reference counts completely so that they don't signal an
604 error when a color is freed whose reference count is already 0.
605 Other X servers do. To help me debug this, the following code
606 implements a simple reference counting schema of its own, for a
607 single display/screen. --gerd. */
609 /* Reference counts for pixel colors. */
611 int color_count
[256];
613 /* Register color PIXEL as allocated. */
616 register_color (pixel
)
619 xassert (pixel
< 256);
620 ++color_count
[pixel
];
624 /* Register color PIXEL as deallocated. */
627 unregister_color (pixel
)
630 xassert (pixel
< 256);
631 if (color_count
[pixel
] > 0)
632 --color_count
[pixel
];
638 /* Register N colors from PIXELS as deallocated. */
641 unregister_colors (pixels
, n
)
642 unsigned long *pixels
;
646 for (i
= 0; i
< n
; ++i
)
647 unregister_color (pixels
[i
]);
651 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
652 doc
: /* Dump currently allocated colors to stderr. */)
657 fputc ('\n', stderr
);
659 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
662 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
665 fputc ('\n', stderr
);
667 fputc ('\t', stderr
);
671 fputc ('\n', stderr
);
675 #endif /* DEBUG_X_COLORS */
678 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
679 color values. Interrupt input must be blocked when this function
683 x_free_colors (f
, pixels
, npixels
)
685 unsigned long *pixels
;
688 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
690 /* If display has an immutable color map, freeing colors is not
691 necessary and some servers don't allow it. So don't do it. */
692 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
694 #ifdef DEBUG_X_COLORS
695 unregister_colors (pixels
, npixels
);
697 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
703 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
704 color values. Interrupt input must be blocked when this function
708 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
712 unsigned long *pixels
;
715 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
716 int class = dpyinfo
->visual
->class;
718 /* If display has an immutable color map, freeing colors is not
719 necessary and some servers don't allow it. So don't do it. */
720 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
722 #ifdef DEBUG_X_COLORS
723 unregister_colors (pixels
, npixels
);
725 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
730 /* Create and return a GC for use on frame F. GC values and mask
731 are given by XGCV and MASK. */
734 x_create_gc (f
, mask
, xgcv
)
741 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
748 /* Free GC which was used on frame F. */
756 xassert (--ngcs
>= 0);
757 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
761 #endif /* HAVE_X_WINDOWS */
764 /* W32 emulation of GCs */
767 x_create_gc (f
, mask
, xgcv
)
774 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
781 /* Free GC which was used on frame F. */
789 xassert (--ngcs
>= 0);
794 #endif /* WINDOWSNT */
797 /* Mac OS emulation of GCs */
799 extern XGCValues
*XCreateGC (void *, Window
, unsigned long, XGCValues
*);
802 x_create_gc (f
, mask
, xgcv
)
808 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
817 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
822 /* Like stricmp. Used to compare parts of font names which are in
827 unsigned char *s1
, *s2
;
831 unsigned char c1
= tolower (*s1
);
832 unsigned char c2
= tolower (*s2
);
834 return c1
< c2
? -1 : 1;
839 return *s2
== 0 ? 0 : -1;
844 /* Like strlwr, which might not always be available. */
846 static unsigned char *
850 unsigned char *p
= s
;
859 /* Signal `error' with message S, and additional argument ARG. */
862 signal_error (s
, arg
)
866 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
870 /* If FRAME is nil, return a pointer to the selected frame.
871 Otherwise, check that FRAME is a live frame, and return a pointer
872 to it. NPARAM is the parameter number of FRAME, for
873 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
874 Lisp function definitions. */
876 static INLINE
struct frame
*
877 frame_or_selected_frame (frame
, nparam
)
882 frame
= selected_frame
;
884 CHECK_LIVE_FRAME (frame
);
885 return XFRAME (frame
);
889 /***********************************************************************
891 ***********************************************************************/
893 /* Initialize face cache and basic faces for frame F. */
899 /* Make a face cache, if F doesn't have one. */
900 if (FRAME_FACE_CACHE (f
) == NULL
)
901 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
903 #ifdef HAVE_WINDOW_SYSTEM
904 /* Make the image cache. */
905 if (FRAME_WINDOW_P (f
))
907 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
908 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
909 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
911 #endif /* HAVE_WINDOW_SYSTEM */
913 /* Realize basic faces. Must have enough information in frame
914 parameters to realize basic faces at this point. */
915 #ifdef HAVE_X_WINDOWS
916 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
919 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
921 if (!realize_basic_faces (f
))
926 /* Free face cache of frame F. Called from Fdelete_frame. */
932 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
936 free_face_cache (face_cache
);
937 FRAME_FACE_CACHE (f
) = NULL
;
940 #ifdef HAVE_WINDOW_SYSTEM
941 if (FRAME_WINDOW_P (f
))
943 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
946 --image_cache
->refcount
;
947 if (image_cache
->refcount
== 0)
948 free_image_cache (f
);
951 #endif /* HAVE_WINDOW_SYSTEM */
955 /* Clear face caches, and recompute basic faces for frame F. Call
956 this after changing frame parameters on which those faces depend,
957 or when realized faces have been freed due to changing attributes
961 recompute_basic_faces (f
)
964 if (FRAME_FACE_CACHE (f
))
966 clear_face_cache (0);
967 if (!realize_basic_faces (f
))
973 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
974 try to free unused fonts, too. */
977 clear_face_cache (clear_fonts_p
)
980 #ifdef HAVE_WINDOW_SYSTEM
981 Lisp_Object tail
, frame
;
985 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
987 struct x_display_info
*dpyinfo
;
989 /* Fonts are common for frames on one display, i.e. on
991 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
992 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
993 clear_font_table (dpyinfo
);
995 /* From time to time see if we can unload some fonts. This also
996 frees all realized faces on all frames. Fonts needed by
997 faces will be loaded again when faces are realized again. */
998 clear_font_table_count
= 0;
1000 FOR_EACH_FRAME (tail
, frame
)
1002 struct frame
*f
= XFRAME (frame
);
1003 if (FRAME_WINDOW_P (f
)
1004 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
1005 free_all_realized_faces (frame
);
1010 /* Clear GCs of realized faces. */
1011 FOR_EACH_FRAME (tail
, frame
)
1014 if (FRAME_WINDOW_P (f
))
1016 clear_face_gcs (FRAME_FACE_CACHE (f
));
1017 clear_image_cache (f
, 0);
1021 #endif /* HAVE_WINDOW_SYSTEM */
1025 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1026 doc
: /* Clear face caches on all frames.
1027 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1029 Lisp_Object thoroughly
;
1031 clear_face_cache (!NILP (thoroughly
));
1032 ++face_change_count
;
1033 ++windows_or_buffers_changed
;
1039 #ifdef HAVE_WINDOW_SYSTEM
1042 /* Remove fonts from the font table of DPYINFO except for the default
1043 ASCII fonts of frames on that display. Called from clear_face_cache
1044 from time to time. */
1047 clear_font_table (dpyinfo
)
1048 struct x_display_info
*dpyinfo
;
1052 /* Free those fonts that are not used by frames on DPYINFO. */
1053 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1055 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1056 Lisp_Object tail
, frame
;
1058 /* Check if slot is already free. */
1059 if (font_info
->name
== NULL
)
1062 /* Don't free a default font of some frame. */
1063 FOR_EACH_FRAME (tail
, frame
)
1065 struct frame
*f
= XFRAME (frame
);
1066 if (FRAME_WINDOW_P (f
)
1067 && font_info
->font
== FRAME_FONT (f
))
1075 if (font_info
->full_name
!= font_info
->name
)
1076 xfree (font_info
->full_name
);
1077 xfree (font_info
->name
);
1079 /* Free the font. */
1081 #ifdef HAVE_X_WINDOWS
1082 XFreeFont (dpyinfo
->display
, font_info
->font
);
1085 w32_unload_font (dpyinfo
, font_info
->font
);
1089 /* Mark font table slot free. */
1090 font_info
->font
= NULL
;
1091 font_info
->name
= font_info
->full_name
= NULL
;
1095 #endif /* HAVE_WINDOW_SYSTEM */
1099 /***********************************************************************
1101 ***********************************************************************/
1103 #ifdef HAVE_WINDOW_SYSTEM
1105 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1106 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1107 A bitmap specification is either a string, a file name, or a list
1108 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1109 HEIGHT is its height, and DATA is a string containing the bits of
1110 the pixmap. Bits are stored row by row, each row occupies
1111 \(WIDTH + 7)/8 bytes. */)
1117 if (STRINGP (object
))
1118 /* If OBJECT is a string, it's a file name. */
1120 else if (CONSP (object
))
1122 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1123 HEIGHT must be integers > 0, and DATA must be string large
1124 enough to hold a bitmap of the specified size. */
1125 Lisp_Object width
, height
, data
;
1127 height
= width
= data
= Qnil
;
1131 width
= XCAR (object
);
1132 object
= XCDR (object
);
1135 height
= XCAR (object
);
1136 object
= XCDR (object
);
1138 data
= XCAR (object
);
1142 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1144 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1146 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1151 return pixmap_p
? Qt
: Qnil
;
1155 /* Load a bitmap according to NAME (which is either a file name or a
1156 pixmap spec) for use on frame F. Value is the bitmap_id (see
1157 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1158 bitmap cannot be loaded, display a message saying so, and return
1159 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1160 if these pointers are not null. */
1163 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1166 unsigned int *w_ptr
, *h_ptr
;
1174 tem
= Fbitmap_spec_p (name
);
1176 wrong_type_argument (Qbitmap_spec_p
, name
);
1181 /* Decode a bitmap spec into a bitmap. */
1186 w
= XINT (Fcar (name
));
1187 h
= XINT (Fcar (Fcdr (name
)));
1188 bits
= Fcar (Fcdr (Fcdr (name
)));
1190 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1195 /* It must be a string -- a file name. */
1196 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1202 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1213 ++npixmaps_allocated
;
1216 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1219 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1225 #endif /* HAVE_WINDOW_SYSTEM */
1229 /***********************************************************************
1231 ***********************************************************************/
1233 #ifdef HAVE_WINDOW_SYSTEM
1235 /* Update the line_height of frame F. Return non-zero if line height
1239 frame_update_line_height (f
)
1242 int line_height
, changed_p
;
1244 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1245 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1246 FRAME_LINE_HEIGHT (f
) = line_height
;
1250 #endif /* HAVE_WINDOW_SYSTEM */
1253 /***********************************************************************
1255 ***********************************************************************/
1257 #ifdef HAVE_WINDOW_SYSTEM
1259 /* Load font of face FACE which is used on frame F to display
1260 character C. The name of the font to load is determined by lface
1261 and fontset of FACE. */
1264 load_face_font (f
, face
, c
)
1269 struct font_info
*font_info
= NULL
;
1272 face
->font_info_id
= -1;
1275 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1280 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1285 face
->font_info_id
= font_info
->font_idx
;
1286 face
->font
= font_info
->font
;
1287 face
->font_name
= font_info
->full_name
;
1290 x_free_gc (f
, face
->gc
);
1295 add_to_log ("Unable to load font %s",
1296 build_string (font_name
), Qnil
);
1300 #endif /* HAVE_WINDOW_SYSTEM */
1304 /***********************************************************************
1306 ***********************************************************************/
1308 /* A version of defined_color for non-X frames. */
1311 tty_defined_color (f
, color_name
, color_def
, alloc
)
1317 Lisp_Object color_desc
;
1318 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1319 unsigned long red
= 0, green
= 0, blue
= 0;
1322 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1326 XSETFRAME (frame
, f
);
1328 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1329 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1331 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1332 if (CONSP (XCDR (XCDR (color_desc
))))
1334 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1335 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1336 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1340 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1341 /* We were called early during startup, and the colors are not
1342 yet set up in tty-defined-color-alist. Don't return a failure
1343 indication, since this produces the annoying "Unable to
1344 load color" messages in the *Messages* buffer. */
1347 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1349 if (strcmp (color_name
, "unspecified-fg") == 0)
1350 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1351 else if (strcmp (color_name
, "unspecified-bg") == 0)
1352 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1355 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1358 color_def
->pixel
= color_idx
;
1359 color_def
->red
= red
;
1360 color_def
->green
= green
;
1361 color_def
->blue
= blue
;
1367 /* Decide if color named COLOR_NAME is valid for the display
1368 associated with the frame F; if so, return the rgb values in
1369 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1371 This does the right thing for any type of frame. */
1374 defined_color (f
, color_name
, color_def
, alloc
)
1380 if (!FRAME_WINDOW_P (f
))
1381 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1382 #ifdef HAVE_X_WINDOWS
1383 else if (FRAME_X_P (f
))
1384 return x_defined_color (f
, color_name
, color_def
, alloc
);
1387 else if (FRAME_W32_P (f
))
1388 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1391 else if (FRAME_MAC_P (f
))
1392 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1399 /* Given the index IDX of a tty color on frame F, return its name, a
1403 tty_color_name (f
, idx
)
1407 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1410 Lisp_Object coldesc
;
1412 XSETFRAME (frame
, f
);
1413 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1415 if (!NILP (coldesc
))
1416 return XCAR (coldesc
);
1419 /* We can have an MSDOG frame under -nw for a short window of
1420 opportunity before internal_terminal_init is called. DTRT. */
1421 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1422 return msdos_stdcolor_name (idx
);
1425 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1426 return build_string (unspecified_fg
);
1427 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1428 return build_string (unspecified_bg
);
1431 return vga_stdcolor_name (idx
);
1434 return Qunspecified
;
1438 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1439 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1442 face_color_gray_p (f
, color_name
)
1449 if (defined_color (f
, color_name
, &color
, 0))
1450 gray_p
= ((abs (color
.red
- color
.green
)
1451 < max (color
.red
, color
.green
) / 20)
1452 && (abs (color
.green
- color
.blue
)
1453 < max (color
.green
, color
.blue
) / 20)
1454 && (abs (color
.blue
- color
.red
)
1455 < max (color
.blue
, color
.red
) / 20));
1463 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1464 BACKGROUND_P non-zero means the color will be used as background
1468 face_color_supported_p (f
, color_name
, background_p
)
1476 XSETFRAME (frame
, f
);
1477 return (FRAME_WINDOW_P (f
)
1478 ? (!NILP (Fxw_display_color_p (frame
))
1479 || xstricmp (color_name
, "black") == 0
1480 || xstricmp (color_name
, "white") == 0
1482 && face_color_gray_p (f
, color_name
))
1483 || (!NILP (Fx_display_grayscale_p (frame
))
1484 && face_color_gray_p (f
, color_name
)))
1485 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1489 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1490 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1491 FRAME specifies the frame and thus the display for interpreting COLOR.
1492 If FRAME is nil or omitted, use the selected frame. */)
1494 Lisp_Object color
, frame
;
1498 CHECK_FRAME (frame
);
1499 CHECK_STRING (color
);
1501 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1505 DEFUN ("color-supported-p", Fcolor_supported_p
,
1506 Scolor_supported_p
, 2, 3, 0,
1507 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1508 BACKGROUND-P non-nil means COLOR is used as a background.
1509 If FRAME is nil or omitted, use the selected frame.
1510 COLOR must be a valid color name. */)
1511 (color
, frame
, background_p
)
1512 Lisp_Object frame
, color
, background_p
;
1516 CHECK_FRAME (frame
);
1517 CHECK_STRING (color
);
1519 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1525 /* Load color with name NAME for use by face FACE on frame F.
1526 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1527 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1528 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1529 pixel color. If color cannot be loaded, display a message, and
1530 return the foreground, background or underline color of F, but
1531 record that fact in flags of the face so that we don't try to free
1535 load_color (f
, face
, name
, target_index
)
1539 enum lface_attribute_index target_index
;
1543 xassert (STRINGP (name
));
1544 xassert (target_index
== LFACE_FOREGROUND_INDEX
1545 || target_index
== LFACE_BACKGROUND_INDEX
1546 || target_index
== LFACE_UNDERLINE_INDEX
1547 || target_index
== LFACE_OVERLINE_INDEX
1548 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1549 || target_index
== LFACE_BOX_INDEX
);
1551 /* if the color map is full, defined_color will return a best match
1552 to the values in an existing cell. */
1553 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1555 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1557 switch (target_index
)
1559 case LFACE_FOREGROUND_INDEX
:
1560 face
->foreground_defaulted_p
= 1;
1561 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1564 case LFACE_BACKGROUND_INDEX
:
1565 face
->background_defaulted_p
= 1;
1566 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1569 case LFACE_UNDERLINE_INDEX
:
1570 face
->underline_defaulted_p
= 1;
1571 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1574 case LFACE_OVERLINE_INDEX
:
1575 face
->overline_color_defaulted_p
= 1;
1576 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1579 case LFACE_STRIKE_THROUGH_INDEX
:
1580 face
->strike_through_color_defaulted_p
= 1;
1581 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1584 case LFACE_BOX_INDEX
:
1585 face
->box_color_defaulted_p
= 1;
1586 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1595 ++ncolors_allocated
;
1602 #ifdef HAVE_WINDOW_SYSTEM
1604 /* Load colors for face FACE which is used on frame F. Colors are
1605 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1606 of ATTRS. If the background color specified is not supported on F,
1607 try to emulate gray colors with a stipple from Vface_default_stipple. */
1610 load_face_colors (f
, face
, attrs
)
1617 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1618 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1620 /* Swap colors if face is inverse-video. */
1621 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1629 /* Check for support for foreground, not for background because
1630 face_color_supported_p is smart enough to know that grays are
1631 "supported" as background because we are supposed to use stipple
1633 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1634 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1636 x_destroy_bitmap (f
, face
->stipple
);
1637 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1638 &face
->pixmap_w
, &face
->pixmap_h
);
1641 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1642 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1646 /* Free color PIXEL on frame F. */
1649 unload_color (f
, pixel
)
1651 unsigned long pixel
;
1653 #ifdef HAVE_X_WINDOWS
1657 x_free_colors (f
, &pixel
, 1);
1664 /* Free colors allocated for FACE. */
1667 free_face_colors (f
, face
)
1671 #ifdef HAVE_X_WINDOWS
1672 if (face
->colors_copied_bitwise_p
)
1677 if (!face
->foreground_defaulted_p
)
1679 x_free_colors (f
, &face
->foreground
, 1);
1680 IF_DEBUG (--ncolors_allocated
);
1683 if (!face
->background_defaulted_p
)
1685 x_free_colors (f
, &face
->background
, 1);
1686 IF_DEBUG (--ncolors_allocated
);
1689 if (face
->underline_p
1690 && !face
->underline_defaulted_p
)
1692 x_free_colors (f
, &face
->underline_color
, 1);
1693 IF_DEBUG (--ncolors_allocated
);
1696 if (face
->overline_p
1697 && !face
->overline_color_defaulted_p
)
1699 x_free_colors (f
, &face
->overline_color
, 1);
1700 IF_DEBUG (--ncolors_allocated
);
1703 if (face
->strike_through_p
1704 && !face
->strike_through_color_defaulted_p
)
1706 x_free_colors (f
, &face
->strike_through_color
, 1);
1707 IF_DEBUG (--ncolors_allocated
);
1710 if (face
->box
!= FACE_NO_BOX
1711 && !face
->box_color_defaulted_p
)
1713 x_free_colors (f
, &face
->box_color
, 1);
1714 IF_DEBUG (--ncolors_allocated
);
1718 #endif /* HAVE_X_WINDOWS */
1721 #endif /* HAVE_WINDOW_SYSTEM */
1725 /***********************************************************************
1727 ***********************************************************************/
1729 /* An enumerator for each field of an XLFD font name. */
1750 /* An enumerator for each possible slant value of a font. Taken from
1751 the XLFD specification. */
1759 XLFD_SLANT_REVERSE_ITALIC
,
1760 XLFD_SLANT_REVERSE_OBLIQUE
,
1764 /* Relative font weight according to XLFD documentation. */
1768 XLFD_WEIGHT_UNKNOWN
,
1769 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1770 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1771 XLFD_WEIGHT_LIGHT
, /* 30 */
1772 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1773 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1774 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1775 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1776 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1777 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1780 /* Relative proportionate width. */
1784 XLFD_SWIDTH_UNKNOWN
,
1785 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1786 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1787 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1788 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1789 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1790 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1791 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1792 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1793 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1796 /* Structure used for tables mapping XLFD weight, slant, and width
1797 names to numeric and symbolic values. */
1803 Lisp_Object
*symbol
;
1806 /* Table of XLFD slant names and their numeric and symbolic
1807 representations. This table must be sorted by slant names in
1810 static struct table_entry slant_table
[] =
1812 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1813 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1814 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1815 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1816 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1817 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1820 /* Table of XLFD weight names. This table must be sorted by weight
1821 names in ascending order. */
1823 static struct table_entry weight_table
[] =
1825 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1826 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1827 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1828 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1829 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1830 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1831 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1832 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1833 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1834 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1835 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1836 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1837 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1838 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1839 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1840 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1843 /* Table of XLFD width names. This table must be sorted by width
1844 names in ascending order. */
1846 static struct table_entry swidth_table
[] =
1848 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1849 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1850 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1851 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1852 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1853 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1854 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1855 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1856 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1857 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1858 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1859 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1860 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1861 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1862 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1865 /* Structure used to hold the result of splitting font names in XLFD
1866 format into their fields. */
1870 /* The original name which is modified destructively by
1871 split_font_name. The pointer is kept here to be able to free it
1872 if it was allocated from the heap. */
1875 /* Font name fields. Each vector element points into `name' above.
1876 Fields are NUL-terminated. */
1877 char *fields
[XLFD_LAST
];
1879 /* Numeric values for those fields that interest us. See
1880 split_font_name for which these are. */
1881 int numeric
[XLFD_LAST
];
1883 /* Lower value mean higher priority. */
1884 int registry_priority
;
1887 /* The frame in effect when sorting font names. Set temporarily in
1888 sort_fonts so that it is available in font comparison functions. */
1890 static struct frame
*font_frame
;
1892 /* Order by which font selection chooses fonts. The default values
1893 mean `first, find a best match for the font width, then for the
1894 font height, then for weight, then for slant.' This variable can be
1895 set via set-face-font-sort-order. */
1898 static int font_sort_order
[4] = {
1899 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1902 static int font_sort_order
[4];
1905 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1906 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1907 is a pointer to the matching table entry or null if no table entry
1910 static struct table_entry
*
1911 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1912 struct table_entry
*table
;
1914 struct font_name
*font
;
1917 /* Function split_font_name converts fields to lower-case, so there
1918 is no need to use xstrlwr or xstricmp here. */
1919 char *s
= font
->fields
[field_index
];
1920 int low
, mid
, high
, cmp
;
1927 mid
= (low
+ high
) / 2;
1928 cmp
= strcmp (table
[mid
].name
, s
);
1942 /* Return a numeric representation for font name field
1943 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1944 has DIM entries. Value is the numeric value found or DFLT if no
1945 table entry matches. This function is used to translate weight,
1946 slant, and swidth names of XLFD font names to numeric values. */
1949 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1950 struct table_entry
*table
;
1952 struct font_name
*font
;
1956 struct table_entry
*p
;
1957 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1958 return p
? p
->numeric
: dflt
;
1962 /* Return a symbolic representation for font name field
1963 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1964 has DIM entries. Value is the symbolic value found or DFLT if no
1965 table entry matches. This function is used to translate weight,
1966 slant, and swidth names of XLFD font names to symbols. */
1968 static INLINE Lisp_Object
1969 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1970 struct table_entry
*table
;
1972 struct font_name
*font
;
1976 struct table_entry
*p
;
1977 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1978 return p
? *p
->symbol
: dflt
;
1982 /* Return a numeric value for the slant of the font given by FONT. */
1985 xlfd_numeric_slant (font
)
1986 struct font_name
*font
;
1988 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1989 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1993 /* Return a symbol representing the weight of the font given by FONT. */
1995 static INLINE Lisp_Object
1996 xlfd_symbolic_slant (font
)
1997 struct font_name
*font
;
1999 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2000 font
, XLFD_SLANT
, Qnormal
);
2004 /* Return a numeric value for the weight of the font given by FONT. */
2007 xlfd_numeric_weight (font
)
2008 struct font_name
*font
;
2010 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2011 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2015 /* Return a symbol representing the slant of the font given by FONT. */
2017 static INLINE Lisp_Object
2018 xlfd_symbolic_weight (font
)
2019 struct font_name
*font
;
2021 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2022 font
, XLFD_WEIGHT
, Qnormal
);
2026 /* Return a numeric value for the swidth of the font whose XLFD font
2027 name fields are found in FONT. */
2030 xlfd_numeric_swidth (font
)
2031 struct font_name
*font
;
2033 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2034 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2038 /* Return a symbolic value for the swidth of FONT. */
2040 static INLINE Lisp_Object
2041 xlfd_symbolic_swidth (font
)
2042 struct font_name
*font
;
2044 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2045 font
, XLFD_SWIDTH
, Qnormal
);
2049 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2050 entries. Value is a pointer to the matching table entry or null if
2051 no element of TABLE contains SYMBOL. */
2053 static struct table_entry
*
2054 face_value (table
, dim
, symbol
)
2055 struct table_entry
*table
;
2061 xassert (SYMBOLP (symbol
));
2063 for (i
= 0; i
< dim
; ++i
)
2064 if (EQ (*table
[i
].symbol
, symbol
))
2067 return i
< dim
? table
+ i
: NULL
;
2071 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2072 entries. Value is -1 if SYMBOL is not found in TABLE. */
2075 face_numeric_value (table
, dim
, symbol
)
2076 struct table_entry
*table
;
2080 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2081 return p
? p
->numeric
: -1;
2085 /* Return a numeric value representing the weight specified by Lisp
2086 symbol WEIGHT. Value is one of the enumerators of enum
2090 face_numeric_weight (weight
)
2093 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2097 /* Return a numeric value representing the slant specified by Lisp
2098 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2101 face_numeric_slant (slant
)
2104 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2108 /* Return a numeric value representing the swidth specified by Lisp
2109 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2112 face_numeric_swidth (width
)
2115 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2119 #ifdef HAVE_WINDOW_SYSTEM
2121 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2125 struct font_name
*font
;
2127 /* Function split_font_name converts fields to lower-case, so there
2128 is no need to use tolower here. */
2129 return *font
->fields
[XLFD_SPACING
] != 'p';
2133 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2135 The actual height of the font when displayed on F depends on the
2136 resolution of both the font and frame. For example, a 10pt font
2137 designed for a 100dpi display will display larger than 10pt on a
2138 75dpi display. (It's not unusual to use fonts not designed for the
2139 display one is using. For example, some intlfonts are available in
2140 72dpi versions, only.)
2142 Value is the real point size of FONT on frame F, or 0 if it cannot
2146 xlfd_point_size (f
, font
)
2148 struct font_name
*font
;
2150 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2151 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2155 if (*pixel_field
== '[')
2157 /* The pixel size field is `[A B C D]' which specifies
2158 a transformation matrix.
2164 by which all glyphs of the font are transformed. The spec
2165 says that s scalar value N for the pixel size is equivalent
2166 to A = N * resx/resy, B = C = 0, D = N. */
2167 char *start
= pixel_field
+ 1, *end
;
2171 for (i
= 0; i
< 4; ++i
)
2173 matrix
[i
] = strtod (start
, &end
);
2180 pixel
= atoi (pixel_field
);
2185 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2191 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2192 of frame F. This function is used to guess a point size of font
2193 when only the pixel height of the font is available. */
2196 pixel_point_size (f
, pixel
)
2200 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2204 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2205 point size of one dot. */
2206 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2207 int_pt
= real_pt
+ 0.5;
2213 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2214 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2215 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2216 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2217 zero if the font name doesn't have the format we expect. The
2218 expected format is a font name that starts with a `-' and has
2219 XLFD_LAST fields separated by `-'. */
2222 split_font_name (f
, font
, numeric_p
)
2224 struct font_name
*font
;
2230 if (*font
->name
== '-')
2232 char *p
= xstrlwr (font
->name
) + 1;
2234 while (i
< XLFD_LAST
)
2236 font
->fields
[i
] = p
;
2239 /* Pixel and point size may be of the form `[....]'. For
2240 BNF, see XLFD spec, chapter 4. Negative values are
2241 indicated by tilde characters which we replace with
2242 `-' characters, here. */
2244 && (i
- 1 == XLFD_PIXEL_SIZE
2245 || i
- 1 == XLFD_POINT_SIZE
))
2250 for (++p
; *p
&& *p
!= ']'; ++p
)
2254 /* Check that the matrix contains 4 floating point
2256 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2259 if (strtod (start
, &end
) == 0 && start
== end
)
2266 while (*p
&& *p
!= '-')
2276 success_p
= i
== XLFD_LAST
;
2278 /* If requested, and font name was in the expected format,
2279 compute numeric values for some fields. */
2280 if (numeric_p
&& success_p
)
2282 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2283 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2284 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2285 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2286 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2287 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2290 /* Initialize it to zero. It will be overridden by font_list while
2291 trying alternate registries. */
2292 font
->registry_priority
= 0;
2298 /* Build an XLFD font name from font name fields in FONT. Value is a
2299 pointer to the font name, which is allocated via xmalloc. */
2302 build_font_name (font
)
2303 struct font_name
*font
;
2307 char *font_name
= (char *) xmalloc (size
);
2308 int total_length
= 0;
2310 for (i
= 0; i
< XLFD_LAST
; ++i
)
2312 /* Add 1 because of the leading `-'. */
2313 int len
= strlen (font
->fields
[i
]) + 1;
2315 /* Reallocate font_name if necessary. Add 1 for the final
2317 if (total_length
+ len
+ 1 >= size
)
2319 int new_size
= max (2 * size
, size
+ len
+ 1);
2320 int sz
= new_size
* sizeof *font_name
;
2321 font_name
= (char *) xrealloc (font_name
, sz
);
2325 font_name
[total_length
] = '-';
2326 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2327 total_length
+= len
;
2330 font_name
[total_length
] = 0;
2335 /* Free an array FONTS of N font_name structures. This frees FONTS
2336 itself and all `name' fields in its elements. */
2339 free_font_names (fonts
, n
)
2340 struct font_name
*fonts
;
2344 xfree (fonts
[--n
].name
);
2349 /* Sort vector FONTS of font_name structures which contains NFONTS
2350 elements using qsort and comparison function CMPFN. F is the frame
2351 on which the fonts will be used. The global variable font_frame
2352 is temporarily set to F to make it available in CMPFN. */
2355 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2357 struct font_name
*fonts
;
2359 int (*cmpfn
) P_ ((const void *, const void *));
2362 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2367 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2368 display in x_display_list. FONTS is a pointer to a vector of
2369 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2370 alternative patterns from Valternate_fontname_alist if no fonts are
2371 found matching PATTERN.
2373 For all fonts found, set FONTS[i].name to the name of the font,
2374 allocated via xmalloc, and split font names into fields. Ignore
2375 fonts that we can't parse. Value is the number of fonts found. */
2378 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2381 struct font_name
*fonts
;
2382 int nfonts
, try_alternatives_p
;
2386 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2387 better to do it the other way around. */
2389 Lisp_Object lpattern
, tem
;
2391 lpattern
= build_string (pattern
);
2393 /* Get the list of fonts matching PATTERN. */
2396 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2399 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2402 /* Make a copy of the font names we got from X, and
2403 split them into fields. */
2405 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2407 Lisp_Object elt
, tail
;
2408 char *name
= XSTRING (XCAR (tem
))->data
;
2410 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2411 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2415 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2424 /* Make a copy of the font name. */
2425 fonts
[n
].name
= xstrdup (name
);
2427 if (split_font_name (f
, fonts
+ n
, 1))
2429 if (font_scalable_p (fonts
+ n
)
2430 && !may_use_scalable_font_p (name
))
2433 xfree (fonts
[n
].name
);
2439 xfree (fonts
[n
].name
);
2442 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2443 if (n
== 0 && try_alternatives_p
)
2445 Lisp_Object list
= Valternate_fontname_alist
;
2447 while (CONSP (list
))
2449 Lisp_Object entry
= XCAR (list
);
2451 && STRINGP (XCAR (entry
))
2452 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2459 Lisp_Object patterns
= XCAR (list
);
2462 while (CONSP (patterns
)
2463 /* If list is screwed up, give up. */
2464 && (name
= XCAR (patterns
),
2466 /* Ignore patterns equal to PATTERN because we tried that
2467 already with no success. */
2468 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2469 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2472 patterns
= XCDR (patterns
);
2480 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2481 using comparison function CMPFN. Value is the number of fonts
2482 found. If value is non-zero, *FONTS is set to a vector of
2483 font_name structures allocated from the heap containing matching
2484 fonts. Each element of *FONTS contains a name member that is also
2485 allocated from the heap. Font names in these structures are split
2486 into fields. Use free_font_names to free such an array. */
2489 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2492 int (*cmpfn
) P_ ((const void *, const void *));
2493 struct font_name
**fonts
;
2497 /* Get the list of fonts matching pattern. 100 should suffice. */
2498 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2499 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2500 nfonts
= XFASTINT (Vfont_list_limit
);
2502 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2503 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2505 /* Sort the resulting array and return it in *FONTS. If no
2506 fonts were found, make sure to set *FONTS to null. */
2508 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2519 /* Compare two font_name structures *A and *B. Value is analogous to
2520 strcmp. Sort order is given by the global variable
2521 font_sort_order. Font names are sorted so that, everything else
2522 being equal, fonts with a resolution closer to that of the frame on
2523 which they are used are listed first. The global variable
2524 font_frame is the frame on which we operate. */
2527 cmp_font_names (a
, b
)
2530 struct font_name
*x
= (struct font_name
*) a
;
2531 struct font_name
*y
= (struct font_name
*) b
;
2534 /* All strings have been converted to lower-case by split_font_name,
2535 so we can use strcmp here. */
2536 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2541 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2543 int j
= font_sort_order
[i
];
2544 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2549 /* Everything else being equal, we prefer fonts with an
2550 y-resolution closer to that of the frame. */
2551 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2552 int x_resy
= x
->numeric
[XLFD_RESY
];
2553 int y_resy
= y
->numeric
[XLFD_RESY
];
2554 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2562 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2563 is non-nil list fonts matching that pattern. Otherwise, if
2564 REGISTRY is non-nil return only fonts with that registry, otherwise
2565 return fonts of any registry. Set *FONTS to a vector of font_name
2566 structures allocated from the heap containing the fonts found.
2567 Value is the number of fonts found. */
2570 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2572 Lisp_Object pattern
, family
, registry
;
2573 struct font_name
**fonts
;
2575 char *pattern_str
, *family_str
, *registry_str
;
2579 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2580 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2582 pattern_str
= (char *) alloca (strlen (family_str
)
2583 + strlen (registry_str
)
2585 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2586 strcat (pattern_str
, family_str
);
2587 strcat (pattern_str
, "-*-");
2588 strcat (pattern_str
, registry_str
);
2589 if (!index (registry_str
, '-'))
2591 if (registry_str
[strlen (registry_str
) - 1] == '*')
2592 strcat (pattern_str
, "-*");
2594 strcat (pattern_str
, "*-*");
2598 pattern_str
= (char *) XSTRING (pattern
)->data
;
2600 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2604 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2605 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2606 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2609 static struct font_name
*
2610 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2611 struct font_name
*fonts1
, *fonts2
;
2612 int nfonts1
, nfonts2
;
2614 int new_nfonts
= nfonts1
+ nfonts2
;
2615 struct font_name
*new_fonts
;
2617 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2618 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2619 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2626 /* Get a sorted list of fonts of family FAMILY on frame F.
2628 If PATTERN is non-nil list fonts matching that pattern.
2630 If REGISTRY is non-nil, return fonts with that registry and the
2631 alternative registries from Vface_alternative_font_registry_alist.
2633 If REGISTRY is nil return fonts of any registry.
2635 Set *FONTS to a vector of font_name structures allocated from the
2636 heap containing the fonts found. Value is the number of fonts
2640 font_list (f
, pattern
, family
, registry
, fonts
)
2642 Lisp_Object pattern
, family
, registry
;
2643 struct font_name
**fonts
;
2645 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2647 if (!NILP (registry
)
2648 && CONSP (Vface_alternative_font_registry_alist
))
2652 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2657 for (alter
= XCDR (alter
), reg_prio
= 1;
2659 alter
= XCDR (alter
), reg_prio
++)
2660 if (STRINGP (XCAR (alter
)))
2663 struct font_name
*fonts2
;
2665 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2667 for (i
= 0; i
< nfonts2
; i
++)
2668 fonts2
[i
].registry_priority
= reg_prio
;
2669 *fonts
= (nfonts
> 0
2670 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2681 /* Remove elements from LIST whose cars are `equal'. Called from
2682 x-family-fonts and x-font-family-list to remove duplicate font
2686 remove_duplicates (list
)
2689 Lisp_Object tail
= list
;
2691 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2693 Lisp_Object next
= XCDR (tail
);
2694 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2695 XSETCDR (tail
, XCDR (next
));
2702 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2703 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2704 If FAMILY is omitted or nil, list all families.
2705 Otherwise, FAMILY must be a string, possibly containing wildcards
2707 If FRAME is omitted or nil, use the selected frame.
2708 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2709 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2710 FAMILY is the font family name. POINT-SIZE is the size of the
2711 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2712 width, weight and slant of the font. These symbols are the same as for
2713 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2714 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2715 giving the registry and encoding of the font.
2716 The result list is sorted according to the current setting of
2717 the face font sort order. */)
2719 Lisp_Object family
, frame
;
2721 struct frame
*f
= check_x_frame (frame
);
2722 struct font_name
*fonts
;
2725 struct gcpro gcpro1
;
2728 CHECK_STRING (family
);
2732 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2733 for (i
= nfonts
- 1; i
>= 0; --i
)
2735 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2738 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2739 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2740 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2741 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2742 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2743 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2744 tem
= build_font_name (fonts
+ i
);
2745 ASET (v
, 6, build_string (tem
));
2746 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2747 fonts
[i
].fields
[XLFD_ENCODING
]);
2748 ASET (v
, 7, build_string (tem
));
2751 result
= Fcons (v
, result
);
2754 remove_duplicates (result
);
2755 free_font_names (fonts
, nfonts
);
2761 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2763 doc
: /* Return a list of available font families on FRAME.
2764 If FRAME is omitted or nil, use the selected frame.
2765 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2766 is a font family, and FIXED-P is non-nil if fonts of that family
2767 are fixed-pitch. */)
2771 struct frame
*f
= check_x_frame (frame
);
2773 struct font_name
*fonts
;
2775 struct gcpro gcpro1
;
2776 int count
= specpdl_ptr
- specpdl
;
2779 /* Let's consider all fonts. Increase the limit for matching
2780 fonts until we have them all. */
2783 specbind (intern ("font-list-limit"), make_number (limit
));
2784 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2786 if (nfonts
== limit
)
2788 free_font_names (fonts
, nfonts
);
2797 for (i
= nfonts
- 1; i
>= 0; --i
)
2798 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2799 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2802 remove_duplicates (result
);
2803 free_font_names (fonts
, nfonts
);
2805 return unbind_to (count
, result
);
2809 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2810 doc
: /* Return a list of the names of available fonts matching PATTERN.
2811 If optional arguments FACE and FRAME are specified, return only fonts
2812 the same size as FACE on FRAME.
2813 PATTERN is a string, perhaps with wildcard characters;
2814 the * character matches any substring, and
2815 the ? character matches any single character.
2816 PATTERN is case-insensitive.
2817 FACE is a face name--a symbol.
2819 The return value is a list of strings, suitable as arguments to
2822 Fonts Emacs can't use may or may not be excluded
2823 even if they match PATTERN and FACE.
2824 The optional fourth argument MAXIMUM sets a limit on how many
2825 fonts to match. The first MAXIMUM fonts are reported.
2826 The optional fifth argument WIDTH, if specified, is a number of columns
2827 occupied by a character of a font. In that case, return only fonts
2828 the WIDTH times as wide as FACE on FRAME. */)
2829 (pattern
, face
, frame
, maximum
, width
)
2830 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2837 CHECK_STRING (pattern
);
2843 CHECK_NATNUM (maximum
);
2844 maxnames
= XINT (maximum
);
2848 CHECK_NUMBER (width
);
2850 /* We can't simply call check_x_frame because this function may be
2851 called before any frame is created. */
2852 f
= frame_or_selected_frame (frame
, 2);
2853 if (!FRAME_WINDOW_P (f
))
2855 /* Perhaps we have not yet created any frame. */
2860 /* Determine the width standard for comparison with the fonts we find. */
2866 /* This is of limited utility since it works with character
2867 widths. Keep it for compatibility. --gerd. */
2868 int face_id
= lookup_named_face (f
, face
, 0);
2869 struct face
*face
= (face_id
< 0
2871 : FACE_FROM_ID (f
, face_id
));
2873 if (face
&& face
->font
)
2874 size
= FONT_WIDTH (face
->font
);
2876 size
= FONT_WIDTH (FRAME_FONT (f
));
2879 size
*= XINT (width
);
2883 Lisp_Object args
[2];
2885 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2887 /* We don't have to check fontsets. */
2889 args
[1] = list_fontsets (f
, pattern
, size
);
2890 return Fnconc (2, args
);
2894 #endif /* HAVE_WINDOW_SYSTEM */
2898 /***********************************************************************
2900 ***********************************************************************/
2902 /* Access face attributes of face LFACE, a Lisp vector. */
2904 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2905 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2906 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2907 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2908 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2909 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2910 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2911 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2912 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2913 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2914 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2915 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2916 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2917 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2918 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2919 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2921 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2922 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2924 #define LFACEP(LFACE) \
2926 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2927 && EQ (AREF (LFACE, 0), Qface))
2932 /* Check consistency of Lisp face attribute vector ATTRS. */
2935 check_lface_attrs (attrs
)
2938 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2939 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2940 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2941 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2942 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2943 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2944 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2945 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2946 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2947 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2948 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2949 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2950 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2951 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2952 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2953 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2954 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2955 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2956 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2957 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2958 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2959 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2960 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2961 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2962 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2963 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2964 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2965 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2966 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2967 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2968 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2969 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2970 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2971 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2972 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2973 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2974 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2975 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2976 #ifdef HAVE_WINDOW_SYSTEM
2977 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2978 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2979 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2980 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2981 || NILP (attrs
[LFACE_FONT_INDEX
])
2982 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2987 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2995 xassert (LFACEP (lface
));
2996 check_lface_attrs (XVECTOR (lface
)->contents
);
3000 #else /* GLYPH_DEBUG == 0 */
3002 #define check_lface_attrs(attrs) (void) 0
3003 #define check_lface(lface) (void) 0
3005 #endif /* GLYPH_DEBUG == 0 */
3008 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3009 to make it a symvol. If FACE_NAME is an alias for another face,
3010 return that face's name. */
3013 resolve_face_name (face_name
)
3014 Lisp_Object face_name
;
3016 Lisp_Object aliased
;
3018 if (STRINGP (face_name
))
3019 face_name
= intern (XSTRING (face_name
)->data
);
3021 while (SYMBOLP (face_name
))
3023 aliased
= Fget (face_name
, Qface_alias
);
3027 face_name
= aliased
;
3034 /* Return the face definition of FACE_NAME on frame F. F null means
3035 return the definition for new frames. FACE_NAME may be a string or
3036 a symbol (apparently Emacs 20.2 allowed strings as face names in
3037 face text properties; Ediff uses that). If FACE_NAME is an alias
3038 for another face, return that face's definition. If SIGNAL_P is
3039 non-zero, signal an error if FACE_NAME is not a valid face name.
3040 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3043 static INLINE Lisp_Object
3044 lface_from_face_name (f
, face_name
, signal_p
)
3046 Lisp_Object face_name
;
3051 face_name
= resolve_face_name (face_name
);
3054 lface
= assq_no_quit (face_name
, f
->face_alist
);
3056 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3059 lface
= XCDR (lface
);
3061 signal_error ("Invalid face", face_name
);
3063 check_lface (lface
);
3068 /* Get face attributes of face FACE_NAME from frame-local faces on
3069 frame F. Store the resulting attributes in ATTRS which must point
3070 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3071 is non-zero, signal an error if FACE_NAME does not name a face.
3072 Otherwise, value is zero if FACE_NAME is not a face. */
3075 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3077 Lisp_Object face_name
;
3084 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3087 bcopy (XVECTOR (lface
)->contents
, attrs
,
3088 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3098 /* Non-zero if all attributes in face attribute vector ATTRS are
3099 specified, i.e. are non-nil. */
3102 lface_fully_specified_p (attrs
)
3107 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3108 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3109 && i
!= LFACE_AVGWIDTH_INDEX
)
3110 if (UNSPECIFIEDP (attrs
[i
]))
3113 return i
== LFACE_VECTOR_SIZE
;
3116 #ifdef HAVE_WINDOW_SYSTEM
3118 /* Set font-related attributes of Lisp face LFACE from the fullname of
3119 the font opened by FONTNAME. If FORCE_P is zero, set only
3120 unspecified attributes of LFACE. The exception is `font'
3121 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3123 If FONTNAME is not available on frame F,
3124 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3125 If the fullname is not in a valid XLFD format,
3126 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3127 in LFACE and return 1.
3128 Otherwise, return 1. */
3131 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3134 Lisp_Object fontname
;
3135 int force_p
, may_fail_p
;
3137 struct font_name font
;
3142 char *font_name
= XSTRING (fontname
)->data
;
3143 struct font_info
*font_info
;
3145 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3146 fontset
= fs_query_fontset (fontname
, 0);
3148 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3150 /* Check if FONT_NAME is surely available on the system. Usually
3151 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3152 returns quickly. But, even if FONT_NAME is not yet cached,
3153 caching it now is not futail because we anyway load the font
3156 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3166 font
.name
= STRDUPA (font_info
->full_name
);
3167 have_xlfd_p
= split_font_name (f
, &font
, 1);
3169 /* Set attributes only if unspecified, otherwise face defaults for
3170 new frames would never take effect. If we couldn't get a font
3171 name conforming to XLFD, set normal values. */
3173 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3178 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3179 + strlen (font
.fields
[XLFD_FOUNDRY
])
3181 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3182 font
.fields
[XLFD_FAMILY
]);
3183 val
= build_string (buffer
);
3186 val
= build_string ("*");
3187 LFACE_FAMILY (lface
) = val
;
3190 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3193 pt
= xlfd_point_size (f
, &font
);
3195 pt
= pixel_point_size (f
, font_info
->height
* 10);
3197 LFACE_HEIGHT (lface
) = make_number (pt
);
3200 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3201 LFACE_SWIDTH (lface
)
3202 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3204 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3205 LFACE_AVGWIDTH (lface
)
3207 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3210 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3211 LFACE_WEIGHT (lface
)
3212 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3214 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3216 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3218 LFACE_FONT (lface
) = fontname
;
3223 #endif /* HAVE_WINDOW_SYSTEM */
3226 /* Merges the face height FROM with the face height TO, and returns the
3227 merged height. If FROM is an invalid height, then INVALID is
3228 returned instead. FROM and TO may be either absolute face heights or
3229 `relative' heights; the returned value is always an absolute height
3230 unless both FROM and TO are relative. GCPRO is a lisp value that
3231 will be protected from garbage-collection if this function makes a
3235 merge_face_heights (from
, to
, invalid
, gcpro
)
3236 Lisp_Object from
, to
, invalid
, gcpro
;
3238 Lisp_Object result
= invalid
;
3240 if (INTEGERP (from
))
3241 /* FROM is absolute, just use it as is. */
3243 else if (FLOATP (from
))
3244 /* FROM is a scale, use it to adjust TO. */
3247 /* relative X absolute => absolute */
3248 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3249 else if (FLOATP (to
))
3250 /* relative X relative => relative */
3251 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3253 else if (FUNCTIONP (from
))
3254 /* FROM is a function, which use to adjust TO. */
3256 /* Call function with current height as argument.
3257 From is the new height. */
3258 Lisp_Object args
[2];
3259 struct gcpro gcpro1
;
3265 result
= safe_call (2, args
);
3269 /* Ensure that if TO was absolute, so is the result. */
3270 if (INTEGERP (to
) && !INTEGERP (result
))
3278 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3279 store the resulting attributes in TO, which must be already be
3280 completely specified and contain only absolute attributes. Every
3281 specified attribute of FROM overrides the corresponding attribute of
3282 TO; relative attributes in FROM are merged with the absolute value in
3283 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3284 face inheritance; it should be Qnil when called from other places. */
3287 merge_face_vectors (f
, from
, to
, cycle_check
)
3289 Lisp_Object
*from
, *to
;
3290 Lisp_Object cycle_check
;
3294 /* If FROM inherits from some other faces, merge their attributes into
3295 TO before merging FROM's direct attributes. Note that an :inherit
3296 attribute of `unspecified' is the same as one of nil; we never
3297 merge :inherit attributes, so nil is more correct, but lots of
3298 other code uses `unspecified' as a generic value for face attributes. */
3299 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3300 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3301 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3303 /* If TO specifies a :font attribute, and FROM specifies some
3304 font-related attribute, we need to clear TO's :font attribute
3305 (because it will be inconsistent with whatever FROM specifies, and
3306 FROM takes precedence). */
3307 if (!NILP (to
[LFACE_FONT_INDEX
])
3308 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3309 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3310 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3311 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3312 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3313 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3314 to
[LFACE_FONT_INDEX
] = Qnil
;
3316 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3317 if (!UNSPECIFIEDP (from
[i
]))
3319 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3320 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3325 /* TO is always an absolute face, which should inherit from nothing.
3326 We blindly copy the :inherit attribute above and fix it up here. */
3327 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3331 /* Checks the `cycle check' variable CHECK to see if it indicates that
3332 EL is part of a cycle; CHECK must be either Qnil or a value returned
3333 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3334 elements after which a cycle might be suspected; after that many
3335 elements, this macro begins consing in order to keep more precise
3338 Returns nil if a cycle was detected, otherwise a new value for CHECK
3341 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3342 the caller should make sure that's ok. */
3344 #define CYCLE_CHECK(check, el, suspicious) \
3347 : (INTEGERP (check) \
3348 ? (XFASTINT (check) < (suspicious) \
3349 ? make_number (XFASTINT (check) + 1) \
3350 : Fcons (el, Qnil)) \
3351 : (!NILP (Fmemq ((el), (check))) \
3353 : Fcons ((el), (check)))))
3356 /* Merge face attributes from the face on frame F whose name is
3357 INHERITS, into the vector of face attributes TO; INHERITS may also be
3358 a list of face names, in which case they are applied in order.
3359 CYCLE_CHECK is used to detect loops in face inheritance.
3360 Returns true if any of the inherited attributes are `font-related'. */
3363 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3365 Lisp_Object inherit
;
3367 Lisp_Object cycle_check
;
3369 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3370 /* Inherit from the named face INHERIT. */
3374 /* Make sure we're not in an inheritance loop. */
3375 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3376 if (NILP (cycle_check
))
3377 /* Cycle detected, ignore any further inheritance. */
3380 lface
= lface_from_face_name (f
, inherit
, 0);
3382 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3384 else if (CONSP (inherit
))
3385 /* Handle a list of inherited faces by calling ourselves recursively
3386 on each element. Note that we only do so for symbol elements, so
3387 it's not possible to infinitely recurse. */
3389 while (CONSP (inherit
))
3391 if (SYMBOLP (XCAR (inherit
)))
3392 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3394 /* Check for a circular inheritance list. */
3395 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3396 if (NILP (cycle_check
))
3397 /* Cycle detected. */
3400 inherit
= XCDR (inherit
);
3406 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3407 is a face property, determine the resulting face attributes on
3408 frame F, and store them in TO. PROP may be a single face
3409 specification or a list of such specifications. Each face
3410 specification can be
3412 1. A symbol or string naming a Lisp face.
3414 2. A property list of the form (KEYWORD VALUE ...) where each
3415 KEYWORD is a face attribute name, and value is an appropriate value
3418 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3419 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3420 for compatibility with 20.2.
3422 Face specifications earlier in lists take precedence over later
3426 merge_face_vector_with_property (f
, to
, prop
)
3433 Lisp_Object first
= XCAR (prop
);
3435 if (EQ (first
, Qforeground_color
)
3436 || EQ (first
, Qbackground_color
))
3438 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3439 . COLOR). COLOR must be a string. */
3440 Lisp_Object color_name
= XCDR (prop
);
3441 Lisp_Object color
= first
;
3443 if (STRINGP (color_name
))
3445 if (EQ (color
, Qforeground_color
))
3446 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3448 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3451 add_to_log ("Invalid face color", color_name
, Qnil
);
3453 else if (SYMBOLP (first
)
3454 && *XSYMBOL (first
)->name
->data
== ':')
3456 /* Assume this is the property list form. */
3457 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3459 Lisp_Object keyword
= XCAR (prop
);
3460 Lisp_Object value
= XCAR (XCDR (prop
));
3462 if (EQ (keyword
, QCfamily
))
3464 if (STRINGP (value
))
3465 to
[LFACE_FAMILY_INDEX
] = value
;
3467 add_to_log ("Invalid face font family", value
, Qnil
);
3469 else if (EQ (keyword
, QCheight
))
3471 Lisp_Object new_height
=
3472 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3475 if (NILP (new_height
))
3476 add_to_log ("Invalid face font height", value
, Qnil
);
3478 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3480 else if (EQ (keyword
, QCweight
))
3483 && face_numeric_weight (value
) >= 0)
3484 to
[LFACE_WEIGHT_INDEX
] = value
;
3486 add_to_log ("Invalid face weight", value
, Qnil
);
3488 else if (EQ (keyword
, QCslant
))
3491 && face_numeric_slant (value
) >= 0)
3492 to
[LFACE_SLANT_INDEX
] = value
;
3494 add_to_log ("Invalid face slant", value
, Qnil
);
3496 else if (EQ (keyword
, QCunderline
))
3501 to
[LFACE_UNDERLINE_INDEX
] = value
;
3503 add_to_log ("Invalid face underline", value
, Qnil
);
3505 else if (EQ (keyword
, QCoverline
))
3510 to
[LFACE_OVERLINE_INDEX
] = value
;
3512 add_to_log ("Invalid face overline", value
, Qnil
);
3514 else if (EQ (keyword
, QCstrike_through
))
3519 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3521 add_to_log ("Invalid face strike-through", value
, Qnil
);
3523 else if (EQ (keyword
, QCbox
))
3526 value
= make_number (1);
3527 if (INTEGERP (value
)
3531 to
[LFACE_BOX_INDEX
] = value
;
3533 add_to_log ("Invalid face box", value
, Qnil
);
3535 else if (EQ (keyword
, QCinverse_video
)
3536 || EQ (keyword
, QCreverse_video
))
3538 if (EQ (value
, Qt
) || NILP (value
))
3539 to
[LFACE_INVERSE_INDEX
] = value
;
3541 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3543 else if (EQ (keyword
, QCforeground
))
3545 if (STRINGP (value
))
3546 to
[LFACE_FOREGROUND_INDEX
] = value
;
3548 add_to_log ("Invalid face foreground", value
, Qnil
);
3550 else if (EQ (keyword
, QCbackground
))
3552 if (STRINGP (value
))
3553 to
[LFACE_BACKGROUND_INDEX
] = value
;
3555 add_to_log ("Invalid face background", value
, Qnil
);
3557 else if (EQ (keyword
, QCstipple
))
3559 #ifdef HAVE_X_WINDOWS
3560 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3561 if (!NILP (pixmap_p
))
3562 to
[LFACE_STIPPLE_INDEX
] = value
;
3564 add_to_log ("Invalid face stipple", value
, Qnil
);
3567 else if (EQ (keyword
, QCwidth
))
3570 && face_numeric_swidth (value
) >= 0)
3571 to
[LFACE_SWIDTH_INDEX
] = value
;
3573 add_to_log ("Invalid face width", value
, Qnil
);
3575 else if (EQ (keyword
, QCinherit
))
3577 if (SYMBOLP (value
))
3578 to
[LFACE_INHERIT_INDEX
] = value
;
3582 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3583 if (!SYMBOLP (XCAR (tail
)))
3586 to
[LFACE_INHERIT_INDEX
] = value
;
3588 add_to_log ("Invalid face inherit", value
, Qnil
);
3592 add_to_log ("Invalid attribute %s in face property",
3595 prop
= XCDR (XCDR (prop
));
3600 /* This is a list of face specs. Specifications at the
3601 beginning of the list take precedence over later
3602 specifications, so we have to merge starting with the
3603 last specification. */
3604 Lisp_Object next
= XCDR (prop
);
3606 merge_face_vector_with_property (f
, to
, next
);
3607 merge_face_vector_with_property (f
, to
, first
);
3612 /* PROP ought to be a face name. */
3613 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3615 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3617 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3622 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3623 Sinternal_make_lisp_face
, 1, 2, 0,
3624 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3625 If FACE was not known as a face before, create a new one.
3626 If optional argument FRAME is specified, make a frame-local face
3627 for that frame. Otherwise operate on the global face definition.
3628 Value is a vector of face attributes. */)
3630 Lisp_Object face
, frame
;
3632 Lisp_Object global_lface
, lface
;
3636 CHECK_SYMBOL (face
);
3637 global_lface
= lface_from_face_name (NULL
, face
, 0);
3641 CHECK_LIVE_FRAME (frame
);
3643 lface
= lface_from_face_name (f
, face
, 0);
3646 f
= NULL
, lface
= Qnil
;
3648 /* Add a global definition if there is none. */
3649 if (NILP (global_lface
))
3651 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3653 AREF (global_lface
, 0) = Qface
;
3654 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3655 Vface_new_frame_defaults
);
3657 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3658 face id to Lisp face is given by the vector lface_id_to_name.
3659 The mapping from Lisp face to Lisp face id is given by the
3660 property `face' of the Lisp face name. */
3661 if (next_lface_id
== lface_id_to_name_size
)
3663 int new_size
= max (50, 2 * lface_id_to_name_size
);
3664 int sz
= new_size
* sizeof *lface_id_to_name
;
3665 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3666 lface_id_to_name_size
= new_size
;
3669 lface_id_to_name
[next_lface_id
] = face
;
3670 Fput (face
, Qface
, make_number (next_lface_id
));
3674 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3675 AREF (global_lface
, i
) = Qunspecified
;
3677 /* Add a frame-local definition. */
3682 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3684 AREF (lface
, 0) = Qface
;
3685 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3688 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3689 AREF (lface
, i
) = Qunspecified
;
3692 lface
= global_lface
;
3694 /* Changing a named face means that all realized faces depending on
3695 that face are invalid. Since we cannot tell which realized faces
3696 depend on the face, make sure they are all removed. This is done
3697 by incrementing face_change_count. The next call to
3698 init_iterator will then free realized faces. */
3699 ++face_change_count
;
3700 ++windows_or_buffers_changed
;
3702 xassert (LFACEP (lface
));
3703 check_lface (lface
);
3708 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3709 Sinternal_lisp_face_p
, 1, 2, 0,
3710 doc
: /* Return non-nil if FACE names a face.
3711 If optional second parameter FRAME is non-nil, check for the
3712 existence of a frame-local face with name FACE on that frame.
3713 Otherwise check for the existence of a global face. */)
3715 Lisp_Object face
, frame
;
3721 CHECK_LIVE_FRAME (frame
);
3722 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3725 lface
= lface_from_face_name (NULL
, face
, 0);
3731 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3732 Sinternal_copy_lisp_face
, 4, 4, 0,
3733 doc
: /* Copy face FROM to TO.
3734 If FRAME it t, copy the global face definition of FROM to the
3735 global face definition of TO. Otherwise, copy the frame-local
3736 definition of FROM on FRAME to the frame-local definition of TO
3737 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3740 (from
, to
, frame
, new_frame
)
3741 Lisp_Object from
, to
, frame
, new_frame
;
3743 Lisp_Object lface
, copy
;
3745 CHECK_SYMBOL (from
);
3747 if (NILP (new_frame
))
3752 /* Copy global definition of FROM. We don't make copies of
3753 strings etc. because 20.2 didn't do it either. */
3754 lface
= lface_from_face_name (NULL
, from
, 1);
3755 copy
= Finternal_make_lisp_face (to
, Qnil
);
3759 /* Copy frame-local definition of FROM. */
3760 CHECK_LIVE_FRAME (frame
);
3761 CHECK_LIVE_FRAME (new_frame
);
3762 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3763 copy
= Finternal_make_lisp_face (to
, new_frame
);
3766 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3767 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3769 /* Changing a named face means that all realized faces depending on
3770 that face are invalid. Since we cannot tell which realized faces
3771 depend on the face, make sure they are all removed. This is done
3772 by incrementing face_change_count. The next call to
3773 init_iterator will then free realized faces. */
3774 ++face_change_count
;
3775 ++windows_or_buffers_changed
;
3781 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3782 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3783 doc
: /* Set attribute ATTR of FACE to VALUE.
3784 FRAME being a frame means change the face on that frame.
3785 FRAME nil means change the face of the selected frame.
3786 FRAME t means change the default for new frames.
3787 FRAME 0 means change the face on all frames, and change the default
3789 (face
, attr
, value
, frame
)
3790 Lisp_Object face
, attr
, value
, frame
;
3793 Lisp_Object old_value
= Qnil
;
3794 /* Set 1 if ATTR is QCfont. */
3795 int font_attr_p
= 0;
3796 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3797 int font_related_attr_p
= 0;
3799 CHECK_SYMBOL (face
);
3800 CHECK_SYMBOL (attr
);
3802 face
= resolve_face_name (face
);
3804 /* If FRAME is 0, change face on all frames, and change the
3805 default for new frames. */
3806 if (INTEGERP (frame
) && XINT (frame
) == 0)
3809 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3810 FOR_EACH_FRAME (tail
, frame
)
3811 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3815 /* Set lface to the Lisp attribute vector of FACE. */
3817 lface
= lface_from_face_name (NULL
, face
, 1);
3821 frame
= selected_frame
;
3823 CHECK_LIVE_FRAME (frame
);
3824 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3826 /* If a frame-local face doesn't exist yet, create one. */
3828 lface
= Finternal_make_lisp_face (face
, frame
);
3831 if (EQ (attr
, QCfamily
))
3833 if (!UNSPECIFIEDP (value
))
3835 CHECK_STRING (value
);
3836 if (XSTRING (value
)->size
== 0)
3837 signal_error ("Invalid face family", value
);
3839 old_value
= LFACE_FAMILY (lface
);
3840 LFACE_FAMILY (lface
) = value
;
3841 font_related_attr_p
= 1;
3843 else if (EQ (attr
, QCheight
))
3845 if (!UNSPECIFIEDP (value
))
3849 test
= (EQ (face
, Qdefault
)
3851 /* The default face must have an absolute size,
3852 otherwise, we do a test merge with a random
3853 height to see if VALUE's ok. */
3854 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3856 if (!INTEGERP (test
) || XINT (test
) <= 0)
3857 signal_error ("Invalid face height", value
);
3860 old_value
= LFACE_HEIGHT (lface
);
3861 LFACE_HEIGHT (lface
) = value
;
3862 font_related_attr_p
= 1;
3864 else if (EQ (attr
, QCweight
))
3866 if (!UNSPECIFIEDP (value
))
3868 CHECK_SYMBOL (value
);
3869 if (face_numeric_weight (value
) < 0)
3870 signal_error ("Invalid face weight", value
);
3872 old_value
= LFACE_WEIGHT (lface
);
3873 LFACE_WEIGHT (lface
) = value
;
3874 font_related_attr_p
= 1;
3876 else if (EQ (attr
, QCslant
))
3878 if (!UNSPECIFIEDP (value
))
3880 CHECK_SYMBOL (value
);
3881 if (face_numeric_slant (value
) < 0)
3882 signal_error ("Invalid face slant", value
);
3884 old_value
= LFACE_SLANT (lface
);
3885 LFACE_SLANT (lface
) = value
;
3886 font_related_attr_p
= 1;
3888 else if (EQ (attr
, QCunderline
))
3890 if (!UNSPECIFIEDP (value
))
3891 if ((SYMBOLP (value
)
3893 && !EQ (value
, Qnil
))
3894 /* Underline color. */
3896 && XSTRING (value
)->size
== 0))
3897 signal_error ("Invalid face underline", value
);
3899 old_value
= LFACE_UNDERLINE (lface
);
3900 LFACE_UNDERLINE (lface
) = value
;
3902 else if (EQ (attr
, QCoverline
))
3904 if (!UNSPECIFIEDP (value
))
3905 if ((SYMBOLP (value
)
3907 && !EQ (value
, Qnil
))
3908 /* Overline color. */
3910 && XSTRING (value
)->size
== 0))
3911 signal_error ("Invalid face overline", value
);
3913 old_value
= LFACE_OVERLINE (lface
);
3914 LFACE_OVERLINE (lface
) = value
;
3916 else if (EQ (attr
, QCstrike_through
))
3918 if (!UNSPECIFIEDP (value
))
3919 if ((SYMBOLP (value
)
3921 && !EQ (value
, Qnil
))
3922 /* Strike-through color. */
3924 && XSTRING (value
)->size
== 0))
3925 signal_error ("Invalid face strike-through", value
);
3927 old_value
= LFACE_STRIKE_THROUGH (lface
);
3928 LFACE_STRIKE_THROUGH (lface
) = value
;
3930 else if (EQ (attr
, QCbox
))
3934 /* Allow t meaning a simple box of width 1 in foreground color
3937 value
= make_number (1);
3939 if (UNSPECIFIEDP (value
))
3941 else if (NILP (value
))
3943 else if (INTEGERP (value
))
3944 valid_p
= XINT (value
) != 0;
3945 else if (STRINGP (value
))
3946 valid_p
= XSTRING (value
)->size
> 0;
3947 else if (CONSP (value
))
3963 if (EQ (k
, QCline_width
))
3965 if (!INTEGERP (v
) || XINT (v
) == 0)
3968 else if (EQ (k
, QCcolor
))
3970 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3973 else if (EQ (k
, QCstyle
))
3975 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3982 valid_p
= NILP (tem
);
3988 signal_error ("Invalid face box", value
);
3990 old_value
= LFACE_BOX (lface
);
3991 LFACE_BOX (lface
) = value
;
3993 else if (EQ (attr
, QCinverse_video
)
3994 || EQ (attr
, QCreverse_video
))
3996 if (!UNSPECIFIEDP (value
))
3998 CHECK_SYMBOL (value
);
3999 if (!EQ (value
, Qt
) && !NILP (value
))
4000 signal_error ("Invalid inverse-video face attribute value", value
);
4002 old_value
= LFACE_INVERSE (lface
);
4003 LFACE_INVERSE (lface
) = value
;
4005 else if (EQ (attr
, QCforeground
))
4007 if (!UNSPECIFIEDP (value
))
4009 /* Don't check for valid color names here because it depends
4010 on the frame (display) whether the color will be valid
4011 when the face is realized. */
4012 CHECK_STRING (value
);
4013 if (XSTRING (value
)->size
== 0)
4014 signal_error ("Empty foreground color value", value
);
4016 old_value
= LFACE_FOREGROUND (lface
);
4017 LFACE_FOREGROUND (lface
) = value
;
4019 else if (EQ (attr
, QCbackground
))
4021 if (!UNSPECIFIEDP (value
))
4023 /* Don't check for valid color names here because it depends
4024 on the frame (display) whether the color will be valid
4025 when the face is realized. */
4026 CHECK_STRING (value
);
4027 if (XSTRING (value
)->size
== 0)
4028 signal_error ("Empty background color value", value
);
4030 old_value
= LFACE_BACKGROUND (lface
);
4031 LFACE_BACKGROUND (lface
) = value
;
4033 else if (EQ (attr
, QCstipple
))
4035 #ifdef HAVE_X_WINDOWS
4036 if (!UNSPECIFIEDP (value
)
4038 && NILP (Fbitmap_spec_p (value
)))
4039 signal_error ("Invalid stipple attribute", value
);
4040 old_value
= LFACE_STIPPLE (lface
);
4041 LFACE_STIPPLE (lface
) = value
;
4042 #endif /* HAVE_X_WINDOWS */
4044 else if (EQ (attr
, QCwidth
))
4046 if (!UNSPECIFIEDP (value
))
4048 CHECK_SYMBOL (value
);
4049 if (face_numeric_swidth (value
) < 0)
4050 signal_error ("Invalid face width", value
);
4052 old_value
= LFACE_SWIDTH (lface
);
4053 LFACE_SWIDTH (lface
) = value
;
4054 font_related_attr_p
= 1;
4056 else if (EQ (attr
, QCfont
))
4058 #ifdef HAVE_WINDOW_SYSTEM
4059 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4061 /* Set font-related attributes of the Lisp face from an XLFD
4066 CHECK_STRING (value
);
4068 f
= SELECTED_FRAME ();
4070 f
= check_x_frame (frame
);
4072 /* VALUE may be a fontset name or an alias of fontset. In
4073 such a case, use the base fontset name. */
4074 tmp
= Fquery_fontset (value
, Qnil
);
4078 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4079 signal_error ("Invalid font or fontset name", value
);
4083 #endif /* HAVE_WINDOW_SYSTEM */
4085 else if (EQ (attr
, QCinherit
))
4088 if (SYMBOLP (value
))
4091 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4092 if (!SYMBOLP (XCAR (tail
)))
4095 LFACE_INHERIT (lface
) = value
;
4097 signal_error ("Invalid face inheritance", value
);
4099 else if (EQ (attr
, QCbold
))
4101 old_value
= LFACE_WEIGHT (lface
);
4102 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4103 font_related_attr_p
= 1;
4105 else if (EQ (attr
, QCitalic
))
4107 old_value
= LFACE_SLANT (lface
);
4108 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4109 font_related_attr_p
= 1;
4112 signal_error ("Invalid face attribute name", attr
);
4114 if (font_related_attr_p
4115 && !UNSPECIFIEDP (value
))
4116 /* If a font-related attribute other than QCfont is specified, the
4117 original `font' attribute nor that of default face is useless
4118 to determine a new font. Thus, we set it to nil so that font
4119 selection mechanism doesn't use it. */
4120 LFACE_FONT (lface
) = Qnil
;
4122 /* Changing a named face means that all realized faces depending on
4123 that face are invalid. Since we cannot tell which realized faces
4124 depend on the face, make sure they are all removed. This is done
4125 by incrementing face_change_count. The next call to
4126 init_iterator will then free realized faces. */
4128 && (EQ (attr
, QCfont
)
4129 || NILP (Fequal (old_value
, value
))))
4131 ++face_change_count
;
4132 ++windows_or_buffers_changed
;
4135 if (!UNSPECIFIEDP (value
)
4136 && NILP (Fequal (old_value
, value
)))
4142 if (EQ (face
, Qdefault
))
4144 #ifdef HAVE_WINDOW_SYSTEM
4145 /* Changed font-related attributes of the `default' face are
4146 reflected in changed `font' frame parameters. */
4148 && (font_related_attr_p
|| font_attr_p
)
4149 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4150 set_font_frame_param (frame
, lface
);
4152 #endif /* HAVE_WINDOW_SYSTEM */
4154 if (EQ (attr
, QCforeground
))
4155 param
= Qforeground_color
;
4156 else if (EQ (attr
, QCbackground
))
4157 param
= Qbackground_color
;
4159 #ifdef HAVE_WINDOW_SYSTEM
4161 else if (EQ (face
, Qscroll_bar
))
4163 /* Changing the colors of `scroll-bar' sets frame parameters
4164 `scroll-bar-foreground' and `scroll-bar-background'. */
4165 if (EQ (attr
, QCforeground
))
4166 param
= Qscroll_bar_foreground
;
4167 else if (EQ (attr
, QCbackground
))
4168 param
= Qscroll_bar_background
;
4170 #endif /* not WINDOWSNT */
4171 else if (EQ (face
, Qborder
))
4173 /* Changing background color of `border' sets frame parameter
4175 if (EQ (attr
, QCbackground
))
4176 param
= Qborder_color
;
4178 else if (EQ (face
, Qcursor
))
4180 /* Changing background color of `cursor' sets frame parameter
4182 if (EQ (attr
, QCbackground
))
4183 param
= Qcursor_color
;
4185 else if (EQ (face
, Qmouse
))
4187 /* Changing background color of `mouse' sets frame parameter
4189 if (EQ (attr
, QCbackground
))
4190 param
= Qmouse_color
;
4192 #endif /* HAVE_WINDOW_SYSTEM */
4193 else if (EQ (face
, Qmenu
))
4195 /* Indicate that we have to update the menu bar when
4196 realizing faces on FRAME. FRAME t change the
4197 default for new frames. We do this by setting
4198 setting the flag in new face caches */
4201 struct frame
*f
= XFRAME (frame
);
4202 if (FRAME_FACE_CACHE (f
) == NULL
)
4203 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4204 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4207 menu_face_changed_default
= 1;
4213 /* Update `default-frame-alist', which is used for new frames. */
4215 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4218 /* Update the current frame's parameters. */
4221 cons
= XCAR (Vparam_value_alist
);
4222 XSETCAR (cons
, param
);
4223 XSETCDR (cons
, value
);
4224 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4233 #ifdef HAVE_WINDOW_SYSTEM
4235 /* Set the `font' frame parameter of FRAME determined from `default'
4236 face attributes LFACE. If a face or fontset name is explicitely
4237 specfied in LFACE, use it as is. Otherwise, determine a font name
4238 from the other font-related atrributes of LFACE. In that case, if
4239 there's no matching font, signals an error. */
4242 set_font_frame_param (frame
, lface
)
4243 Lisp_Object frame
, lface
;
4245 struct frame
*f
= XFRAME (frame
);
4247 if (FRAME_WINDOW_P (f
))
4249 Lisp_Object font_name
;
4252 if (STRINGP (LFACE_FONT (lface
)))
4253 font_name
= LFACE_FONT (lface
);
4256 /* Choose a font name that reflects LFACE's attributes and has
4257 the registry and encoding pattern specified in the default
4258 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4259 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4261 error ("No font matches the specified attribute");
4262 font_name
= build_string (font
);
4266 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4271 /* Update the corresponding face when frame parameter PARAM on frame F
4272 has been assigned the value NEW_VALUE. */
4275 update_face_from_frame_parameter (f
, param
, new_value
)
4277 Lisp_Object param
, new_value
;
4281 /* If there are no faces yet, give up. This is the case when called
4282 from Fx_create_frame, and we do the necessary things later in
4283 face-set-after-frame-defaults. */
4284 if (NILP (f
->face_alist
))
4287 /* Changing a named face means that all realized faces depending on
4288 that face are invalid. Since we cannot tell which realized faces
4289 depend on the face, make sure they are all removed. This is done
4290 by incrementing face_change_count. The next call to
4291 init_iterator will then free realized faces. */
4292 ++face_change_count
;
4293 ++windows_or_buffers_changed
;
4295 if (EQ (param
, Qforeground_color
))
4297 lface
= lface_from_face_name (f
, Qdefault
, 1);
4298 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4299 ? new_value
: Qunspecified
);
4300 realize_basic_faces (f
);
4302 else if (EQ (param
, Qbackground_color
))
4306 /* Changing the background color might change the background
4307 mode, so that we have to load new defface specs. Call
4308 frame-update-face-colors to do that. */
4309 XSETFRAME (frame
, f
);
4310 call1 (Qframe_update_face_colors
, frame
);
4312 lface
= lface_from_face_name (f
, Qdefault
, 1);
4313 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4314 ? new_value
: Qunspecified
);
4315 realize_basic_faces (f
);
4317 if (EQ (param
, Qborder_color
))
4319 lface
= lface_from_face_name (f
, Qborder
, 1);
4320 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4321 ? new_value
: Qunspecified
);
4323 else if (EQ (param
, Qcursor_color
))
4325 lface
= lface_from_face_name (f
, Qcursor
, 1);
4326 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4327 ? new_value
: Qunspecified
);
4329 else if (EQ (param
, Qmouse_color
))
4331 lface
= lface_from_face_name (f
, Qmouse
, 1);
4332 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4333 ? new_value
: Qunspecified
);
4338 /* Get the value of X resource RESOURCE, class CLASS for the display
4339 of frame FRAME. This is here because ordinary `x-get-resource'
4340 doesn't take a frame argument. */
4342 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4343 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4344 (resource
, class, frame
)
4345 Lisp_Object resource
, class, frame
;
4347 Lisp_Object value
= Qnil
;
4350 CHECK_STRING (resource
);
4351 CHECK_STRING (class);
4352 CHECK_LIVE_FRAME (frame
);
4354 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4355 resource
, class, Qnil
, Qnil
);
4357 #endif /* not MAC_OS */
4358 #endif /* not WINDOWSNT */
4363 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4364 If VALUE is "on" or "true", return t. If VALUE is "off" or
4365 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4366 error; if SIGNAL_P is zero, return 0. */
4369 face_boolean_x_resource_value (value
, signal_p
)
4373 Lisp_Object result
= make_number (0);
4375 xassert (STRINGP (value
));
4377 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4378 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4380 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4381 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4383 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4384 result
= Qunspecified
;
4386 signal_error ("Invalid face attribute value from X resource", value
);
4392 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4393 Finternal_set_lisp_face_attribute_from_resource
,
4394 Sinternal_set_lisp_face_attribute_from_resource
,
4395 3, 4, 0, doc
: /* */)
4396 (face
, attr
, value
, frame
)
4397 Lisp_Object face
, attr
, value
, frame
;
4399 CHECK_SYMBOL (face
);
4400 CHECK_SYMBOL (attr
);
4401 CHECK_STRING (value
);
4403 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4404 value
= Qunspecified
;
4405 else if (EQ (attr
, QCheight
))
4407 value
= Fstring_to_number (value
, make_number (10));
4408 if (XINT (value
) <= 0)
4409 signal_error ("Invalid face height from X resource", value
);
4411 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4412 value
= face_boolean_x_resource_value (value
, 1);
4413 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4414 value
= intern (XSTRING (value
)->data
);
4415 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4416 value
= face_boolean_x_resource_value (value
, 1);
4417 else if (EQ (attr
, QCunderline
)
4418 || EQ (attr
, QCoverline
)
4419 || EQ (attr
, QCstrike_through
))
4421 Lisp_Object boolean_value
;
4423 /* If the result of face_boolean_x_resource_value is t or nil,
4424 VALUE does NOT specify a color. */
4425 boolean_value
= face_boolean_x_resource_value (value
, 0);
4426 if (SYMBOLP (boolean_value
))
4427 value
= boolean_value
;
4429 else if (EQ (attr
, QCbox
))
4430 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4432 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4435 #endif /* HAVE_WINDOW_SYSTEM */
4438 /***********************************************************************
4440 ***********************************************************************/
4442 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4444 /* Make menus on frame F appear as specified by the `menu' face. */
4447 x_update_menu_appearance (f
)
4450 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4454 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4458 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4459 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4460 char *myname
= XSTRING (Vx_resource_name
)->data
;
4463 const char *popup_path
= "popup_menu";
4465 const char *popup_path
= "menu.popup";
4468 if (STRINGP (LFACE_FOREGROUND (lface
)))
4470 sprintf (line
, "%s.%s*foreground: %s",
4472 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4473 XrmPutLineResource (&rdb
, line
);
4474 sprintf (line
, "%s.pane.menubar*foreground: %s",
4475 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4476 XrmPutLineResource (&rdb
, line
);
4480 if (STRINGP (LFACE_BACKGROUND (lface
)))
4482 sprintf (line
, "%s.%s*background: %s",
4484 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4485 XrmPutLineResource (&rdb
, line
);
4486 sprintf (line
, "%s.pane.menubar*background: %s",
4487 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4488 XrmPutLineResource (&rdb
, line
);
4493 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4494 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4495 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4496 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4497 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4498 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4501 const char *suffix
= "List";
4503 const char *suffix
= "";
4505 sprintf (line
, "%s.pane.menubar*font%s: %s",
4506 myname
, suffix
, face
->font_name
);
4507 XrmPutLineResource (&rdb
, line
);
4508 sprintf (line
, "%s.%s*font%s: %s",
4509 myname
, popup_path
, suffix
, face
->font_name
);
4510 XrmPutLineResource (&rdb
, line
);
4514 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4515 free_frame_menubar (f
);
4519 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4522 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4523 Sface_attribute_relative_p
,
4525 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4527 Lisp_Object attribute
, value
;
4529 if (EQ (value
, Qunspecified
))
4531 else if (EQ (attribute
, QCheight
))
4532 return INTEGERP (value
) ? Qnil
: Qt
;
4537 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4539 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4540 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4541 the result will be absolute, otherwise it will be relative. */)
4542 (attribute
, value1
, value2
)
4543 Lisp_Object attribute
, value1
, value2
;
4545 if (EQ (value1
, Qunspecified
))
4547 else if (EQ (attribute
, QCheight
))
4548 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4554 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4555 Sinternal_get_lisp_face_attribute
,
4557 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4558 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4559 face attribute name, signal an error.
4560 If the optional argument FRAME is given, report on face FACE in that
4561 frame. If FRAME is t, report on the defaults for face FACE (for new
4562 frames). If FRAME is omitted or nil, use the selected frame. */)
4563 (symbol
, keyword
, frame
)
4564 Lisp_Object symbol
, keyword
, frame
;
4566 Lisp_Object lface
, value
= Qnil
;
4568 CHECK_SYMBOL (symbol
);
4569 CHECK_SYMBOL (keyword
);
4572 lface
= lface_from_face_name (NULL
, symbol
, 1);
4576 frame
= selected_frame
;
4577 CHECK_LIVE_FRAME (frame
);
4578 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4581 if (EQ (keyword
, QCfamily
))
4582 value
= LFACE_FAMILY (lface
);
4583 else if (EQ (keyword
, QCheight
))
4584 value
= LFACE_HEIGHT (lface
);
4585 else if (EQ (keyword
, QCweight
))
4586 value
= LFACE_WEIGHT (lface
);
4587 else if (EQ (keyword
, QCslant
))
4588 value
= LFACE_SLANT (lface
);
4589 else if (EQ (keyword
, QCunderline
))
4590 value
= LFACE_UNDERLINE (lface
);
4591 else if (EQ (keyword
, QCoverline
))
4592 value
= LFACE_OVERLINE (lface
);
4593 else if (EQ (keyword
, QCstrike_through
))
4594 value
= LFACE_STRIKE_THROUGH (lface
);
4595 else if (EQ (keyword
, QCbox
))
4596 value
= LFACE_BOX (lface
);
4597 else if (EQ (keyword
, QCinverse_video
)
4598 || EQ (keyword
, QCreverse_video
))
4599 value
= LFACE_INVERSE (lface
);
4600 else if (EQ (keyword
, QCforeground
))
4601 value
= LFACE_FOREGROUND (lface
);
4602 else if (EQ (keyword
, QCbackground
))
4603 value
= LFACE_BACKGROUND (lface
);
4604 else if (EQ (keyword
, QCstipple
))
4605 value
= LFACE_STIPPLE (lface
);
4606 else if (EQ (keyword
, QCwidth
))
4607 value
= LFACE_SWIDTH (lface
);
4608 else if (EQ (keyword
, QCinherit
))
4609 value
= LFACE_INHERIT (lface
);
4610 else if (EQ (keyword
, QCfont
))
4611 value
= LFACE_FONT (lface
);
4613 signal_error ("Invalid face attribute name", keyword
);
4619 DEFUN ("internal-lisp-face-attribute-values",
4620 Finternal_lisp_face_attribute_values
,
4621 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4622 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4623 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4627 Lisp_Object result
= Qnil
;
4629 CHECK_SYMBOL (attr
);
4631 if (EQ (attr
, QCweight
)
4632 || EQ (attr
, QCslant
)
4633 || EQ (attr
, QCwidth
))
4635 /* Extract permissible symbols from tables. */
4636 struct table_entry
*table
;
4639 if (EQ (attr
, QCweight
))
4640 table
= weight_table
, dim
= DIM (weight_table
);
4641 else if (EQ (attr
, QCslant
))
4642 table
= slant_table
, dim
= DIM (slant_table
);
4644 table
= swidth_table
, dim
= DIM (swidth_table
);
4646 for (i
= 0; i
< dim
; ++i
)
4648 Lisp_Object symbol
= *table
[i
].symbol
;
4649 Lisp_Object tail
= result
;
4652 && !EQ (XCAR (tail
), symbol
))
4656 result
= Fcons (symbol
, result
);
4659 else if (EQ (attr
, QCunderline
))
4660 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4661 else if (EQ (attr
, QCoverline
))
4662 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4663 else if (EQ (attr
, QCstrike_through
))
4664 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4665 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4666 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4672 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4673 Sinternal_merge_in_global_face
, 2, 2, 0,
4674 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4675 Default face attributes override any local face attributes. */)
4677 Lisp_Object face
, frame
;
4680 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4682 CHECK_LIVE_FRAME (frame
);
4683 global_lface
= lface_from_face_name (NULL
, face
, 1);
4684 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4685 if (NILP (local_lface
))
4686 local_lface
= Finternal_make_lisp_face (face
, frame
);
4688 /* Make every specified global attribute override the local one.
4689 BEWARE!! This is only used from `face-set-after-frame-default' where
4690 the local frame is defined from default specs in `face-defface-spec'
4691 and those should be overridden by global settings. Hence the strange
4692 "global before local" priority. */
4693 lvec
= XVECTOR (local_lface
)->contents
;
4694 gvec
= XVECTOR (global_lface
)->contents
;
4695 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4696 if (! UNSPECIFIEDP (gvec
[i
]))
4703 /* The following function is implemented for compatibility with 20.2.
4704 The function is used in x-resolve-fonts when it is asked to
4705 return fonts with the same size as the font of a face. This is
4706 done in fontset.el. */
4708 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4709 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4710 If the optional argument FRAME is given, report on face FACE in that frame.
4711 If FRAME is t, report on the defaults for face FACE (for new frames).
4712 The font default for a face is either nil, or a list
4713 of the form (bold), (italic) or (bold italic).
4714 If FRAME is omitted or nil, use the selected frame. */)
4716 Lisp_Object face
, frame
;
4720 Lisp_Object result
= Qnil
;
4721 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4723 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4724 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4725 result
= Fcons (Qbold
, result
);
4727 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4728 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4729 result
= Fcons (Qitalic
, result
);
4735 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4736 int face_id
= lookup_named_face (f
, face
, 0);
4737 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4738 return face
? build_string (face
->font_name
) : Qnil
;
4743 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4744 all attributes are `equal'. Tries to be fast because this function
4745 is called quite often. */
4748 lface_equal_p (v1
, v2
)
4749 Lisp_Object
*v1
, *v2
;
4753 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4755 Lisp_Object a
= v1
[i
];
4756 Lisp_Object b
= v2
[i
];
4758 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4759 and the other is specified. */
4760 equal_p
= XTYPE (a
) == XTYPE (b
);
4769 equal_p
= ((STRING_BYTES (XSTRING (a
))
4770 == STRING_BYTES (XSTRING (b
)))
4771 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4772 STRING_BYTES (XSTRING (a
))) == 0);
4781 equal_p
= !NILP (Fequal (a
, b
));
4791 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4792 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4793 doc
: /* True if FACE1 and FACE2 are equal.
4794 If the optional argument FRAME is given, report on face FACE in that frame.
4795 If FRAME is t, report on the defaults for face FACE (for new frames).
4796 If FRAME is omitted or nil, use the selected frame. */)
4797 (face1
, face2
, frame
)
4798 Lisp_Object face1
, face2
, frame
;
4802 Lisp_Object lface1
, lface2
;
4807 /* Don't use check_x_frame here because this function is called
4808 before X frames exist. At that time, if FRAME is nil,
4809 selected_frame will be used which is the frame dumped with
4810 Emacs. That frame is not an X frame. */
4811 f
= frame_or_selected_frame (frame
, 2);
4813 lface1
= lface_from_face_name (NULL
, face1
, 1);
4814 lface2
= lface_from_face_name (NULL
, face2
, 1);
4815 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4816 XVECTOR (lface2
)->contents
);
4817 return equal_p
? Qt
: Qnil
;
4821 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4822 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4823 doc
: /* True if FACE has no attribute specified.
4824 If the optional argument FRAME is given, report on face FACE in that frame.
4825 If FRAME is t, report on the defaults for face FACE (for new frames).
4826 If FRAME is omitted or nil, use the selected frame. */)
4828 Lisp_Object face
, frame
;
4835 frame
= selected_frame
;
4836 CHECK_LIVE_FRAME (frame
);
4840 lface
= lface_from_face_name (NULL
, face
, 1);
4842 lface
= lface_from_face_name (f
, face
, 1);
4844 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4845 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4848 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4852 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4854 doc
: /* Return an alist of frame-local faces defined on FRAME.
4855 For internal use only. */)
4859 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4860 return f
->face_alist
;
4864 /* Return a hash code for Lisp string STRING with case ignored. Used
4865 below in computing a hash value for a Lisp face. */
4867 static INLINE
unsigned
4868 hash_string_case_insensitive (string
)
4873 xassert (STRINGP (string
));
4874 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4875 hash
= (hash
<< 1) ^ tolower (*s
);
4880 /* Return a hash code for face attribute vector V. */
4882 static INLINE
unsigned
4886 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4887 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4888 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4889 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4890 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4891 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4892 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4896 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4897 considering charsets/registries). They do if they specify the same
4898 family, point size, weight, width, slant, and fontset. Both LFACE1
4899 and LFACE2 must be fully-specified. */
4902 lface_same_font_attributes_p (lface1
, lface2
)
4903 Lisp_Object
*lface1
, *lface2
;
4905 xassert (lface_fully_specified_p (lface1
)
4906 && lface_fully_specified_p (lface2
));
4907 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4908 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4909 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4910 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4911 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4912 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4913 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4914 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4915 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4916 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4917 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4918 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4923 /***********************************************************************
4925 ***********************************************************************/
4927 /* Allocate and return a new realized face for Lisp face attribute
4930 static struct face
*
4931 make_realized_face (attr
)
4934 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4935 bzero (face
, sizeof *face
);
4936 face
->ascii_face
= face
;
4937 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4942 /* Free realized face FACE, including its X resources. FACE may
4946 free_realized_face (f
, face
)
4952 #ifdef HAVE_WINDOW_SYSTEM
4953 if (FRAME_WINDOW_P (f
))
4955 /* Free fontset of FACE if it is ASCII face. */
4956 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4957 free_face_fontset (f
, face
);
4960 x_free_gc (f
, face
->gc
);
4964 free_face_colors (f
, face
);
4965 x_destroy_bitmap (f
, face
->stipple
);
4967 #endif /* HAVE_WINDOW_SYSTEM */
4974 /* Prepare face FACE for subsequent display on frame F. This
4975 allocated GCs if they haven't been allocated yet or have been freed
4976 by clearing the face cache. */
4979 prepare_face_for_display (f
, face
)
4983 #ifdef HAVE_WINDOW_SYSTEM
4984 xassert (FRAME_WINDOW_P (f
));
4989 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4991 xgcv
.foreground
= face
->foreground
;
4992 xgcv
.background
= face
->background
;
4993 #ifdef HAVE_X_WINDOWS
4994 xgcv
.graphics_exposures
= False
;
4996 /* The font of FACE may be null if we couldn't load it. */
4999 #ifdef HAVE_X_WINDOWS
5000 xgcv
.font
= face
->font
->fid
;
5003 xgcv
.font
= face
->font
;
5006 xgcv
.font
= face
->font
;
5012 #ifdef HAVE_X_WINDOWS
5015 xgcv
.fill_style
= FillOpaqueStippled
;
5016 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5017 mask
|= GCFillStyle
| GCStipple
;
5020 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5023 #endif /* HAVE_WINDOW_SYSTEM */
5027 /***********************************************************************
5029 ***********************************************************************/
5031 /* Return a new face cache for frame F. */
5033 static struct face_cache
*
5037 struct face_cache
*c
;
5040 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5041 bzero (c
, sizeof *c
);
5042 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5043 c
->buckets
= (struct face
**) xmalloc (size
);
5044 bzero (c
->buckets
, size
);
5046 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5048 c
->menu_face_changed_p
= menu_face_changed_default
;
5053 /* Clear out all graphics contexts for all realized faces, except for
5054 the basic faces. This should be done from time to time just to avoid
5055 keeping too many graphics contexts that are no longer needed. */
5059 struct face_cache
*c
;
5061 if (c
&& FRAME_WINDOW_P (c
->f
))
5063 #ifdef HAVE_WINDOW_SYSTEM
5065 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5067 struct face
*face
= c
->faces_by_id
[i
];
5068 if (face
&& face
->gc
)
5070 x_free_gc (c
->f
, face
->gc
);
5074 #endif /* HAVE_WINDOW_SYSTEM */
5079 /* Free all realized faces in face cache C, including basic faces. C
5080 may be null. If faces are freed, make sure the frame's current
5081 matrix is marked invalid, so that a display caused by an expose
5082 event doesn't try to use faces we destroyed. */
5085 free_realized_faces (c
)
5086 struct face_cache
*c
;
5091 struct frame
*f
= c
->f
;
5093 /* We must block input here because we can't process X events
5094 safely while only some faces are freed, or when the frame's
5095 current matrix still references freed faces. */
5098 for (i
= 0; i
< c
->used
; ++i
)
5100 free_realized_face (f
, c
->faces_by_id
[i
]);
5101 c
->faces_by_id
[i
] = NULL
;
5105 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5106 bzero (c
->buckets
, size
);
5108 /* Must do a thorough redisplay the next time. Mark current
5109 matrices as invalid because they will reference faces freed
5110 above. This function is also called when a frame is
5111 destroyed. In this case, the root window of F is nil. */
5112 if (WINDOWP (f
->root_window
))
5114 clear_current_matrices (f
);
5115 ++windows_or_buffers_changed
;
5123 /* Free all faces realized for multibyte characters on frame F that
5127 free_realized_multibyte_face (f
, fontset
)
5131 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5135 /* We must block input here because we can't process X events safely
5136 while only some faces are freed, or when the frame's current
5137 matrix still references freed faces. */
5140 for (i
= 0; i
< cache
->used
; i
++)
5142 face
= cache
->faces_by_id
[i
];
5144 && face
!= face
->ascii_face
5145 && face
->fontset
== fontset
)
5147 uncache_face (cache
, face
);
5148 free_realized_face (f
, face
);
5152 /* Must do a thorough redisplay the next time. Mark current
5153 matrices as invalid because they will reference faces freed
5154 above. This function is also called when a frame is destroyed.
5155 In this case, the root window of F is nil. */
5156 if (WINDOWP (f
->root_window
))
5158 clear_current_matrices (f
);
5159 ++windows_or_buffers_changed
;
5166 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5167 This is done after attributes of a named face have been changed,
5168 because we can't tell which realized faces depend on that face. */
5171 free_all_realized_faces (frame
)
5177 FOR_EACH_FRAME (rest
, frame
)
5178 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5181 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5185 /* Free face cache C and faces in it, including their X resources. */
5189 struct face_cache
*c
;
5193 free_realized_faces (c
);
5195 xfree (c
->faces_by_id
);
5201 /* Cache realized face FACE in face cache C. HASH is the hash value
5202 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5203 collision list of the face hash table of C. This is done because
5204 otherwise lookup_face would find FACE for every character, even if
5205 faces with the same attributes but for specific characters exist. */
5208 cache_face (c
, face
, hash
)
5209 struct face_cache
*c
;
5213 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5217 if (face
->fontset
>= 0)
5219 struct face
*last
= c
->buckets
[i
];
5230 c
->buckets
[i
] = face
;
5231 face
->prev
= face
->next
= NULL
;
5237 face
->next
= c
->buckets
[i
];
5239 face
->next
->prev
= face
;
5240 c
->buckets
[i
] = face
;
5243 /* Find a free slot in C->faces_by_id and use the index of the free
5244 slot as FACE->id. */
5245 for (i
= 0; i
< c
->used
; ++i
)
5246 if (c
->faces_by_id
[i
] == NULL
)
5250 /* Maybe enlarge C->faces_by_id. */
5251 if (i
== c
->used
&& c
->used
== c
->size
)
5253 int new_size
= 2 * c
->size
;
5254 int sz
= new_size
* sizeof *c
->faces_by_id
;
5255 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5260 /* Check that FACE got a unique id. */
5265 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5266 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5272 #endif /* GLYPH_DEBUG */
5274 c
->faces_by_id
[i
] = face
;
5280 /* Remove face FACE from cache C. */
5283 uncache_face (c
, face
)
5284 struct face_cache
*c
;
5287 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5290 face
->prev
->next
= face
->next
;
5292 c
->buckets
[i
] = face
->next
;
5295 face
->next
->prev
= face
->prev
;
5297 c
->faces_by_id
[face
->id
] = NULL
;
5298 if (face
->id
== c
->used
)
5303 /* Look up a realized face with face attributes ATTR in the face cache
5304 of frame F. The face will be used to display character C. Value
5305 is the ID of the face found. If no suitable face is found, realize
5306 a new one. In that case, if C is a multibyte character, BASE_FACE
5307 is a face that has the same attributes. */
5310 lookup_face (f
, attr
, c
, base_face
)
5314 struct face
*base_face
;
5316 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5321 xassert (cache
!= NULL
);
5322 check_lface_attrs (attr
);
5324 /* Look up ATTR in the face cache. */
5325 hash
= lface_hash (attr
);
5326 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5328 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5329 if (face
->hash
== hash
5330 && (!FRAME_WINDOW_P (f
)
5331 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5332 && lface_equal_p (face
->lface
, attr
))
5335 /* If not found, realize a new face. */
5337 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5340 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5342 /* When this function is called from face_for_char (in this case, C is
5343 a multibyte character), a fontset of a face returned by
5344 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5345 C) is not sutisfied. The fontset is set for this face by
5346 face_for_char later. */
5348 if (FRAME_WINDOW_P (f
))
5349 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5351 #endif /* GLYPH_DEBUG */
5357 /* Return the face id of the realized face for named face SYMBOL on
5358 frame F suitable for displaying character C. Value is -1 if the
5359 face couldn't be determined, which might happen if the default face
5360 isn't realized and cannot be realized. */
5363 lookup_named_face (f
, symbol
, c
)
5368 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5369 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5370 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5372 if (default_face
== NULL
)
5374 if (!realize_basic_faces (f
))
5376 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5379 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5380 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5381 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5382 return lookup_face (f
, attrs
, c
, NULL
);
5386 /* Return the ID of the realized ASCII face of Lisp face with ID
5387 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5390 ascii_face_of_lisp_face (f
, lface_id
)
5396 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5398 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5399 face_id
= lookup_named_face (f
, face_name
, 0);
5408 /* Return a face for charset ASCII that is like the face with id
5409 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5410 STEPS < 0 means larger. Value is the id of the face. */
5413 smaller_face (f
, face_id
, steps
)
5417 #ifdef HAVE_WINDOW_SYSTEM
5419 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5420 int pt
, last_pt
, last_height
;
5423 struct face
*new_face
;
5425 /* If not called for an X frame, just return the original face. */
5426 if (FRAME_TERMCAP_P (f
))
5429 /* Try in increments of 1/2 pt. */
5430 delta
= steps
< 0 ? 5 : -5;
5431 steps
= abs (steps
);
5433 face
= FACE_FROM_ID (f
, face_id
);
5434 bcopy (face
->lface
, attrs
, sizeof attrs
);
5435 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5436 new_face_id
= face_id
;
5437 last_height
= FONT_HEIGHT (face
->font
);
5441 /* Give up if we cannot find a font within 10pt. */
5442 && abs (last_pt
- pt
) < 100)
5444 /* Look up a face for a slightly smaller/larger font. */
5446 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5447 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5448 new_face
= FACE_FROM_ID (f
, new_face_id
);
5450 /* If height changes, count that as one step. */
5451 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5452 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5455 last_height
= FONT_HEIGHT (new_face
->font
);
5462 #else /* not HAVE_WINDOW_SYSTEM */
5466 #endif /* not HAVE_WINDOW_SYSTEM */
5470 /* Return a face for charset ASCII that is like the face with id
5471 FACE_ID on frame F, but has height HEIGHT. */
5474 face_with_height (f
, face_id
, height
)
5479 #ifdef HAVE_WINDOW_SYSTEM
5481 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5483 if (FRAME_TERMCAP_P (f
)
5487 face
= FACE_FROM_ID (f
, face_id
);
5488 bcopy (face
->lface
, attrs
, sizeof attrs
);
5489 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5490 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5491 #endif /* HAVE_WINDOW_SYSTEM */
5497 /* Return the face id of the realized face for named face SYMBOL on
5498 frame F suitable for displaying character C, and use attributes of
5499 the face FACE_ID for attributes that aren't completely specified by
5500 SYMBOL. This is like lookup_named_face, except that the default
5501 attributes come from FACE_ID, not from the default face. FACE_ID
5502 is assumed to be already realized. */
5505 lookup_derived_face (f
, symbol
, c
, face_id
)
5511 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5512 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5513 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5518 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5519 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5520 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5521 return lookup_face (f
, attrs
, c
, default_face
);
5524 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5525 Sface_attributes_as_vector
, 1, 1, 0,
5526 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5531 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5533 merge_face_vector_with_property (XFRAME (selected_frame
),
5534 XVECTOR (lface
)->contents
,
5541 /***********************************************************************
5543 ***********************************************************************/
5545 DEFUN ("internal-set-font-selection-order",
5546 Finternal_set_font_selection_order
,
5547 Sinternal_set_font_selection_order
, 1, 1, 0,
5548 doc
: /* Set font selection order for face font selection to ORDER.
5549 ORDER must be a list of length 4 containing the symbols `:width',
5550 `:height', `:weight', and `:slant'. Face attributes appearing
5551 first in ORDER are matched first, e.g. if `:height' appears before
5552 `:weight' in ORDER, font selection first tries to find a font with
5553 a suitable height, and then tries to match the font weight.
5560 int indices
[DIM (font_sort_order
)];
5563 bzero (indices
, sizeof indices
);
5567 CONSP (list
) && i
< DIM (indices
);
5568 list
= XCDR (list
), ++i
)
5570 Lisp_Object attr
= XCAR (list
);
5573 if (EQ (attr
, QCwidth
))
5575 else if (EQ (attr
, QCheight
))
5576 xlfd
= XLFD_POINT_SIZE
;
5577 else if (EQ (attr
, QCweight
))
5579 else if (EQ (attr
, QCslant
))
5584 if (indices
[i
] != 0)
5589 if (!NILP (list
) || i
!= DIM (indices
))
5590 signal_error ("Invalid font sort order", order
);
5591 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5592 if (indices
[i
] == 0)
5593 signal_error ("Invalid font sort order", order
);
5595 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5597 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5598 free_all_realized_faces (Qnil
);
5605 DEFUN ("internal-set-alternative-font-family-alist",
5606 Finternal_set_alternative_font_family_alist
,
5607 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5608 doc
: /* Define alternative font families to try in face font selection.
5609 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5610 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5611 be found. Value is ALIST. */)
5616 Vface_alternative_font_family_alist
= alist
;
5617 free_all_realized_faces (Qnil
);
5622 DEFUN ("internal-set-alternative-font-registry-alist",
5623 Finternal_set_alternative_font_registry_alist
,
5624 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5625 doc
: /* Define alternative font registries to try in face font selection.
5626 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5627 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5628 be found. Value is ALIST. */)
5633 Vface_alternative_font_registry_alist
= alist
;
5634 free_all_realized_faces (Qnil
);
5639 #ifdef HAVE_WINDOW_SYSTEM
5641 /* Value is non-zero if FONT is the name of a scalable font. The
5642 X11R6 XLFD spec says that point size, pixel size, and average width
5643 are zero for scalable fonts. Intlfonts contain at least one
5644 scalable font ("*-muleindian-1") for which this isn't true, so we
5645 just test average width. */
5648 font_scalable_p (font
)
5649 struct font_name
*font
;
5651 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5652 return (*s
== '0' && *(s
+ 1) == '\0')
5654 /* Windows implementation of XLFD is slightly broken for backward
5655 compatibility with previous broken versions, so test for
5656 wildcards as well as 0. */
5663 /* Ignore the difference of font point size less than this value. */
5665 #define FONT_POINT_SIZE_QUANTUM 5
5667 /* Value is non-zero if FONT1 is a better match for font attributes
5668 VALUES than FONT2. VALUES is an array of face attribute values in
5669 font sort order. COMPARE_PT_P zero means don't compare point
5670 sizes. AVGWIDTH, if not zero, is a specified font average width
5674 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5676 struct font_name
*font1
, *font2
;
5677 int compare_pt_p
, avgwidth
;
5681 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5683 int xlfd_idx
= font_sort_order
[i
];
5685 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5687 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5688 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5690 if (xlfd_idx
== XLFD_POINT_SIZE
5691 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5693 if (delta1
> delta2
)
5695 else if (delta1
< delta2
)
5699 /* The difference may be equal because, e.g., the face
5700 specifies `italic' but we have only `regular' and
5701 `oblique'. Prefer `oblique' in this case. */
5702 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5703 && font1
->numeric
[xlfd_idx
] > values
[i
]
5704 && font2
->numeric
[xlfd_idx
] < values
[i
])
5712 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5713 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5714 if (delta1
> delta2
)
5716 else if (delta1
< delta2
)
5720 return font1
->registry_priority
< font2
->registry_priority
;
5724 /* Value is non-zero if FONT is an exact match for face attributes in
5725 SPECIFIED. SPECIFIED is an array of face attribute values in font
5726 sort order. AVGWIDTH, if non-zero, is an average width to compare
5730 exact_face_match_p (specified
, font
, avgwidth
)
5732 struct font_name
*font
;
5737 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5738 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5741 return (i
== DIM (font_sort_order
)
5743 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5747 /* Value is the name of a scaled font, generated from scalable font
5748 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5749 Value is allocated from heap. */
5752 build_scalable_font_name (f
, font
, specified_pt
)
5754 struct font_name
*font
;
5757 char point_size
[20], pixel_size
[20];
5759 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5762 /* If scalable font is for a specific resolution, compute
5763 the point size we must specify from the resolution of
5764 the display and the specified resolution of the font. */
5765 if (font
->numeric
[XLFD_RESY
] != 0)
5767 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5768 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5773 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5776 /* Set point size of the font. */
5777 sprintf (point_size
, "%d", (int) pt
);
5778 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5779 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5781 /* Set pixel size. */
5782 sprintf (pixel_size
, "%d", pixel_value
);
5783 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5784 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5786 /* If font doesn't specify its resolution, use the
5787 resolution of the display. */
5788 if (font
->numeric
[XLFD_RESY
] == 0)
5791 sprintf (buffer
, "%d", (int) resy
);
5792 font
->fields
[XLFD_RESY
] = buffer
;
5793 font
->numeric
[XLFD_RESY
] = resy
;
5796 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5799 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5800 sprintf (buffer
, "%d", resx
);
5801 font
->fields
[XLFD_RESX
] = buffer
;
5802 font
->numeric
[XLFD_RESX
] = resx
;
5805 return build_font_name (font
);
5809 /* Value is non-zero if we are allowed to use scalable font FONT. We
5810 can't run a Lisp function here since this function may be called
5811 with input blocked. */
5814 may_use_scalable_font_p (font
)
5817 if (EQ (Vscalable_fonts_allowed
, Qt
))
5819 else if (CONSP (Vscalable_fonts_allowed
))
5821 Lisp_Object tail
, regexp
;
5823 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5825 regexp
= XCAR (tail
);
5826 if (STRINGP (regexp
)
5827 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5837 /* Return the name of the best matching font for face attributes ATTRS
5838 in the array of font_name structures FONTS which contains NFONTS
5839 elements. WIDTH_RATIO is a factor with which to multiply average
5840 widths if ATTRS specifies such a width.
5842 Value is a font name which is allocated from the heap. FONTS is
5843 freed by this function. */
5846 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5849 struct font_name
*fonts
;
5854 struct font_name
*best
;
5857 int exact_p
, avgwidth
;
5862 /* Make specified font attributes available in `specified',
5863 indexed by sort order. */
5864 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5866 int xlfd_idx
= font_sort_order
[i
];
5868 if (xlfd_idx
== XLFD_SWIDTH
)
5869 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5870 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5871 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5872 else if (xlfd_idx
== XLFD_WEIGHT
)
5873 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5874 else if (xlfd_idx
== XLFD_SLANT
)
5875 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5880 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5882 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5886 /* Start with the first non-scalable font in the list. */
5887 for (i
= 0; i
< nfonts
; ++i
)
5888 if (!font_scalable_p (fonts
+ i
))
5891 /* Find the best match among the non-scalable fonts. */
5896 for (i
= 1; i
< nfonts
; ++i
)
5897 if (!font_scalable_p (fonts
+ i
)
5898 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5902 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5911 /* Unless we found an exact match among non-scalable fonts, see if
5912 we can find a better match among scalable fonts. */
5915 /* A scalable font is better if
5917 1. its weight, slant, swidth attributes are better, or.
5919 2. the best non-scalable font doesn't have the required
5920 point size, and the scalable fonts weight, slant, swidth
5923 int non_scalable_has_exact_height_p
;
5925 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5926 non_scalable_has_exact_height_p
= 1;
5928 non_scalable_has_exact_height_p
= 0;
5930 for (i
= 0; i
< nfonts
; ++i
)
5931 if (font_scalable_p (fonts
+ i
))
5934 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5935 || (!non_scalable_has_exact_height_p
5936 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5941 if (font_scalable_p (best
))
5942 font_name
= build_scalable_font_name (f
, best
, pt
);
5944 font_name
= build_font_name (best
);
5946 /* Free font_name structures. */
5947 free_font_names (fonts
, nfonts
);
5953 /* Get a list of matching fonts on frame F, considering FAMILY
5954 and alternative font families from Vface_alternative_font_registry_alist.
5956 FAMILY is the font family whose alternatives are considered.
5958 REGISTRY, if a string, specifies a font registry and encoding to
5959 match. A value of nil means include fonts of any registry and
5962 Return in *FONTS a pointer to a vector of font_name structures for
5963 the fonts matched. Value is the number of fonts found. */
5966 try_alternative_families (f
, family
, registry
, fonts
)
5968 Lisp_Object family
, registry
;
5969 struct font_name
**fonts
;
5974 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5977 /* Try alternative font families. */
5978 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5981 for (alter
= XCDR (alter
);
5982 CONSP (alter
) && nfonts
== 0;
5983 alter
= XCDR (alter
))
5985 if (STRINGP (XCAR (alter
)))
5986 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5990 /* Try scalable fonts before giving up. */
5991 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
5993 int count
= BINDING_STACK_SIZE ();
5994 specbind (Qscalable_fonts_allowed
, Qt
);
5995 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5996 unbind_to (count
, Qnil
);
6003 /* Get a list of matching fonts on frame F.
6005 FAMILY, if a string, specifies a font family derived from the fontset.
6006 It is only used if the face does not specify any family in ATTRS or
6007 if we cannot find any font of the face's family.
6009 REGISTRY, if a string, specifies a font registry and encoding to
6010 match. A value of nil means include fonts of any registry and
6013 Return in *FONTS a pointer to a vector of font_name structures for
6014 the fonts matched. Value is the number of fonts found. */
6017 try_font_list (f
, attrs
, family
, registry
, fonts
)
6020 Lisp_Object family
, registry
;
6021 struct font_name
**fonts
;
6024 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6026 if (STRINGP (face_family
))
6027 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
6029 if (nfonts
== 0 && !NILP (family
))
6030 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6032 /* Try font family of the default face or "fixed". */
6035 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6037 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6039 family
= build_string ("fixed");
6040 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6043 /* Try any family with the given registry. */
6045 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6051 /* Return the fontset id of the base fontset name or alias name given
6052 by the fontset attribute of ATTRS. Value is -1 if the fontset
6053 attribute of ATTRS doesn't name a fontset. */
6056 face_fontset (attrs
)
6061 name
= attrs
[LFACE_FONT_INDEX
];
6062 if (!STRINGP (name
))
6064 return fs_query_fontset (name
, 0);
6068 /* Choose a name of font to use on frame F to display character C with
6069 Lisp face attributes specified by ATTRS. The font name is
6070 determined by the font-related attributes in ATTRS and the name
6071 pattern for C in FONTSET. Value is the font name which is
6072 allocated from the heap and must be freed by the caller, or NULL if
6073 we can get no information about the font name of C. It is assured
6074 that we always get some information for a single byte
6078 choose_face_font (f
, attrs
, fontset
, c
)
6083 Lisp_Object pattern
;
6084 char *font_name
= NULL
;
6085 struct font_name
*fonts
;
6086 int nfonts
, width_ratio
;
6088 /* Get (foundry and) family name and registry (and encoding) name of
6090 pattern
= fontset_font_pattern (f
, fontset
, c
);
6093 xassert (!SINGLE_BYTE_CHAR_P (c
));
6097 /* If what we got is a name pattern, return it. */
6098 if (STRINGP (pattern
))
6099 return xstrdup (XSTRING (pattern
)->data
);
6101 /* Get a list of fonts matching that pattern and choose the
6102 best match for the specified face attributes from it. */
6103 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
6104 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6106 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6107 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6111 #endif /* HAVE_WINDOW_SYSTEM */
6115 /***********************************************************************
6117 ***********************************************************************/
6119 /* Realize basic faces on frame F. Value is zero if frame parameters
6120 of F don't contain enough information needed to realize the default
6124 realize_basic_faces (f
)
6128 int count
= BINDING_STACK_SIZE ();
6130 /* Block input here so that we won't be surprised by an X expose
6131 event, for instance, without having the faces set up. */
6133 specbind (Qscalable_fonts_allowed
, Qt
);
6135 if (realize_default_face (f
))
6137 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6138 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6139 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6140 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6141 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6142 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6143 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6144 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6145 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6146 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6148 /* Reflect changes in the `menu' face in menu bars. */
6149 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6151 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6152 #ifdef USE_X_TOOLKIT
6153 x_update_menu_appearance (f
);
6160 unbind_to (count
, Qnil
);
6166 /* Realize the default face on frame F. If the face is not fully
6167 specified, make it fully-specified. Attributes of the default face
6168 that are not explicitly specified are taken from frame parameters. */
6171 realize_default_face (f
)
6174 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6176 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6177 Lisp_Object frame_font
;
6180 /* If the `default' face is not yet known, create it. */
6181 lface
= lface_from_face_name (f
, Qdefault
, 0);
6185 XSETFRAME (frame
, f
);
6186 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6189 #ifdef HAVE_WINDOW_SYSTEM
6190 if (FRAME_WINDOW_P (f
))
6192 /* Set frame_font to the value of the `font' frame parameter. */
6193 frame_font
= Fassq (Qfont
, f
->param_alist
);
6194 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6195 frame_font
= XCDR (frame_font
);
6196 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6198 #endif /* HAVE_WINDOW_SYSTEM */
6200 if (!FRAME_WINDOW_P (f
))
6202 LFACE_FAMILY (lface
) = build_string ("default");
6203 LFACE_SWIDTH (lface
) = Qnormal
;
6204 LFACE_HEIGHT (lface
) = make_number (1);
6205 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6206 LFACE_WEIGHT (lface
) = Qnormal
;
6207 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6208 LFACE_SLANT (lface
) = Qnormal
;
6209 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6212 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6213 LFACE_UNDERLINE (lface
) = Qnil
;
6215 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6216 LFACE_OVERLINE (lface
) = Qnil
;
6218 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6219 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6221 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6222 LFACE_BOX (lface
) = Qnil
;
6224 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6225 LFACE_INVERSE (lface
) = Qnil
;
6227 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6229 /* This function is called so early that colors are not yet
6230 set in the frame parameter list. */
6231 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6233 if (CONSP (color
) && STRINGP (XCDR (color
)))
6234 LFACE_FOREGROUND (lface
) = XCDR (color
);
6235 else if (FRAME_WINDOW_P (f
))
6237 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6238 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6243 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6245 /* This function is called so early that colors are not yet
6246 set in the frame parameter list. */
6247 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6248 if (CONSP (color
) && STRINGP (XCDR (color
)))
6249 LFACE_BACKGROUND (lface
) = XCDR (color
);
6250 else if (FRAME_WINDOW_P (f
))
6252 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6253 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6258 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6259 LFACE_STIPPLE (lface
) = Qnil
;
6261 /* Realize the face; it must be fully-specified now. */
6262 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6263 check_lface (lface
);
6264 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6265 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6270 /* Realize basic faces other than the default face in face cache C.
6271 SYMBOL is the face name, ID is the face id the realized face must
6272 have. The default face must have been realized already. */
6275 realize_named_face (f
, symbol
, id
)
6280 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6281 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6282 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6283 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6284 struct face
*new_face
;
6286 /* The default face must exist and be fully specified. */
6287 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6288 check_lface_attrs (attrs
);
6289 xassert (lface_fully_specified_p (attrs
));
6291 /* If SYMBOL isn't know as a face, create it. */
6295 XSETFRAME (frame
, f
);
6296 lface
= Finternal_make_lisp_face (symbol
, frame
);
6299 /* Merge SYMBOL's face with the default face. */
6300 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6301 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6303 /* Realize the face. */
6304 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6308 /* Realize the fully-specified face with attributes ATTRS in face
6309 cache CACHE for character C. If C is a multibyte character,
6310 BASE_FACE is a face that has the same attributes. Otherwise,
6311 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6312 ID of face to remove before caching the new face. Value is a
6313 pointer to the newly created realized face. */
6315 static struct face
*
6316 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6317 struct face_cache
*cache
;
6320 struct face
*base_face
;
6325 /* LFACE must be fully specified. */
6326 xassert (cache
!= NULL
);
6327 check_lface_attrs (attrs
);
6329 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6331 /* Remove the former face. */
6332 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6333 uncache_face (cache
, former_face
);
6334 free_realized_face (cache
->f
, former_face
);
6337 if (FRAME_WINDOW_P (cache
->f
))
6338 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6339 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6340 face
= realize_tty_face (cache
, attrs
, c
);
6344 /* Insert the new face. */
6345 cache_face (cache
, face
, lface_hash (attrs
));
6346 #ifdef HAVE_WINDOW_SYSTEM
6347 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6348 load_face_font (cache
->f
, face
, c
);
6349 #endif /* HAVE_WINDOW_SYSTEM */
6354 /* Realize the fully-specified face with attributes ATTRS in face
6355 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6356 a multibyte character, BASE_FACE is a face that has the same
6357 attributes. Otherwise, BASE_FACE is ignored. If the new face
6358 doesn't share font with the default face, a fontname is allocated
6359 from the heap and set in `font_name' of the new face, but it is not
6360 yet loaded here. Value is a pointer to the newly created realized
6363 static struct face
*
6364 realize_x_face (cache
, attrs
, c
, base_face
)
6365 struct face_cache
*cache
;
6368 struct face
*base_face
;
6370 #ifdef HAVE_WINDOW_SYSTEM
6371 struct face
*face
, *default_face
;
6373 Lisp_Object stipple
, overline
, strike_through
, box
;
6375 xassert (FRAME_WINDOW_P (cache
->f
));
6376 xassert (SINGLE_BYTE_CHAR_P (c
)
6379 /* Allocate a new realized face. */
6380 face
= make_realized_face (attrs
);
6384 /* If C is a multibyte character, we share all face attirbutes with
6385 BASE_FACE including the realized fontset. But, we must load a
6387 if (!SINGLE_BYTE_CHAR_P (c
))
6389 bcopy (base_face
, face
, sizeof *face
);
6392 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6393 face
->colors_copied_bitwise_p
= 1;
6395 /* to force realize_face to load font */
6400 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6402 /* Determine the font to use. Most of the time, the font will be
6403 the same as the font of the default face, so try that first. */
6404 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6406 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6407 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6409 face
->font
= default_face
->font
;
6410 face
->fontset
= default_face
->fontset
;
6411 face
->font_info_id
= default_face
->font_info_id
;
6412 face
->font_name
= default_face
->font_name
;
6413 face
->ascii_face
= face
;
6415 /* But, as we can't share the fontset, make a new realized
6416 fontset that has the same base fontset as of the default
6419 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6423 /* If the face attribute ATTRS specifies a fontset, use it as
6424 the base of a new realized fontset. Otherwise, use the same
6425 base fontset as of the default face. The base determines
6426 registry and encoding of a font. It may also determine
6427 foundry and family. The other fields of font name pattern
6428 are constructed from ATTRS. */
6429 int fontset
= face_fontset (attrs
);
6431 if ((fontset
== -1) && default_face
)
6432 fontset
= default_face
->fontset
;
6433 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6434 face
->font
= NULL
; /* to force realize_face to load font */
6437 /* Load the font if it is specified in ATTRS. This fixes
6438 changing frame font on the Mac. */
6439 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6441 struct font_info
*font_info
=
6442 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6444 face
->font
= font_info
->font
;
6449 /* Load colors, and set remaining attributes. */
6451 load_face_colors (f
, face
, attrs
);
6454 box
= attrs
[LFACE_BOX_INDEX
];
6457 /* A simple box of line width 1 drawn in color given by
6459 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6461 face
->box
= FACE_SIMPLE_BOX
;
6462 face
->box_line_width
= 1;
6464 else if (INTEGERP (box
))
6466 /* Simple box of specified line width in foreground color of the
6468 xassert (XINT (box
) != 0);
6469 face
->box
= FACE_SIMPLE_BOX
;
6470 face
->box_line_width
= XINT (box
);
6471 face
->box_color
= face
->foreground
;
6472 face
->box_color_defaulted_p
= 1;
6474 else if (CONSP (box
))
6476 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6477 being one of `raised' or `sunken'. */
6478 face
->box
= FACE_SIMPLE_BOX
;
6479 face
->box_color
= face
->foreground
;
6480 face
->box_color_defaulted_p
= 1;
6481 face
->box_line_width
= 1;
6485 Lisp_Object keyword
, value
;
6487 keyword
= XCAR (box
);
6495 if (EQ (keyword
, QCline_width
))
6497 if (INTEGERP (value
) && XINT (value
) != 0)
6498 face
->box_line_width
= XINT (value
);
6500 else if (EQ (keyword
, QCcolor
))
6502 if (STRINGP (value
))
6504 face
->box_color
= load_color (f
, face
, value
,
6506 face
->use_box_color_for_shadows_p
= 1;
6509 else if (EQ (keyword
, QCstyle
))
6511 if (EQ (value
, Qreleased_button
))
6512 face
->box
= FACE_RAISED_BOX
;
6513 else if (EQ (value
, Qpressed_button
))
6514 face
->box
= FACE_SUNKEN_BOX
;
6519 /* Text underline, overline, strike-through. */
6521 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6523 /* Use default color (same as foreground color). */
6524 face
->underline_p
= 1;
6525 face
->underline_defaulted_p
= 1;
6526 face
->underline_color
= 0;
6528 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6530 /* Use specified color. */
6531 face
->underline_p
= 1;
6532 face
->underline_defaulted_p
= 0;
6533 face
->underline_color
6534 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6535 LFACE_UNDERLINE_INDEX
);
6537 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6539 face
->underline_p
= 0;
6540 face
->underline_defaulted_p
= 0;
6541 face
->underline_color
= 0;
6544 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6545 if (STRINGP (overline
))
6547 face
->overline_color
6548 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6549 LFACE_OVERLINE_INDEX
);
6550 face
->overline_p
= 1;
6552 else if (EQ (overline
, Qt
))
6554 face
->overline_color
= face
->foreground
;
6555 face
->overline_color_defaulted_p
= 1;
6556 face
->overline_p
= 1;
6559 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6560 if (STRINGP (strike_through
))
6562 face
->strike_through_color
6563 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6564 LFACE_STRIKE_THROUGH_INDEX
);
6565 face
->strike_through_p
= 1;
6567 else if (EQ (strike_through
, Qt
))
6569 face
->strike_through_color
= face
->foreground
;
6570 face
->strike_through_color_defaulted_p
= 1;
6571 face
->strike_through_p
= 1;
6574 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6575 if (!NILP (stipple
))
6576 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6578 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6580 #endif /* HAVE_WINDOW_SYSTEM */
6584 /* Map a specified color of face FACE on frame F to a tty color index.
6585 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6586 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6587 default foreground/background colors. */
6590 map_tty_color (f
, face
, idx
, defaulted
)
6593 enum lface_attribute_index idx
;
6596 Lisp_Object frame
, color
, def
;
6597 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6598 unsigned long default_pixel
, default_other_pixel
, pixel
;
6600 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6604 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6605 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6609 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6610 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6613 XSETFRAME (frame
, f
);
6614 color
= face
->lface
[idx
];
6617 && XSTRING (color
)->size
6618 && CONSP (Vtty_defined_color_alist
)
6619 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6622 /* Associations in tty-defined-color-alist are of the form
6623 (NAME INDEX R G B). We need the INDEX part. */
6624 pixel
= XINT (XCAR (XCDR (def
)));
6627 if (pixel
== default_pixel
&& STRINGP (color
))
6629 pixel
= load_color (f
, face
, color
, idx
);
6631 #if defined (MSDOS) || defined (WINDOWSNT)
6632 /* If the foreground of the default face is the default color,
6633 use the foreground color defined by the frame. */
6635 if (FRAME_MSDOS_P (f
))
6638 if (pixel
== default_pixel
6639 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6642 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6644 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6645 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6648 else if (pixel
== default_other_pixel
)
6651 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6653 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6654 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6660 #endif /* MSDOS or WINDOWSNT */
6664 face
->foreground
= pixel
;
6666 face
->background
= pixel
;
6670 /* Realize the fully-specified face with attributes ATTRS in face
6671 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6672 pointer to the newly created realized face. */
6674 static struct face
*
6675 realize_tty_face (cache
, attrs
, c
)
6676 struct face_cache
*cache
;
6682 int face_colors_defaulted
= 0;
6683 struct frame
*f
= cache
->f
;
6685 /* Frame must be a termcap frame. */
6686 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6688 /* Allocate a new realized face. */
6689 face
= make_realized_face (attrs
);
6690 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6692 /* Map face attributes to TTY appearances. We map slant to
6693 dimmed text because we want italic text to appear differently
6694 and because dimmed text is probably used infrequently. */
6695 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6696 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6698 if (weight
> XLFD_WEIGHT_MEDIUM
)
6699 face
->tty_bold_p
= 1;
6700 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6701 face
->tty_dim_p
= 1;
6702 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6703 face
->tty_underline_p
= 1;
6704 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6705 face
->tty_reverse_p
= 1;
6707 /* Map color names to color indices. */
6708 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6709 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6711 /* Swap colors if face is inverse-video. If the colors are taken
6712 from the frame colors, they are already inverted, since the
6713 frame-creation function calls x-handle-reverse-video. */
6714 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6716 unsigned long tem
= face
->foreground
;
6717 face
->foreground
= face
->background
;
6718 face
->background
= tem
;
6721 if (tty_suppress_bold_inverse_default_colors_p
6723 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6724 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6725 face
->tty_bold_p
= 0;
6731 DEFUN ("tty-suppress-bold-inverse-default-colors",
6732 Ftty_suppress_bold_inverse_default_colors
,
6733 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6734 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6735 SUPPRESS non-nil means suppress it.
6736 This affects bold faces on TTYs whose foreground is the default background
6737 color of the display and whose background is the default foreground color.
6738 For such faces, the bold face attribute is ignored if this variable
6741 Lisp_Object suppress
;
6743 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6744 ++face_change_count
;
6750 /***********************************************************************
6752 ***********************************************************************/
6754 /* Return the ID of the face to use to display character CH with face
6755 property PROP on frame F in current_buffer. */
6758 compute_char_face (f
, ch
, prop
)
6765 if (NILP (current_buffer
->enable_multibyte_characters
))
6770 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6771 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6775 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6776 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6777 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6778 merge_face_vector_with_property (f
, attrs
, prop
);
6779 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6785 /* Return the face ID associated with buffer position POS for
6786 displaying ASCII characters. Return in *ENDPTR the position at
6787 which a different face is needed, as far as text properties and
6788 overlays are concerned. W is a window displaying current_buffer.
6790 REGION_BEG, REGION_END delimit the region, so it can be
6793 LIMIT is a position not to scan beyond. That is to limit the time
6794 this function can take.
6796 If MOUSE is non-zero, use the character's mouse-face, not its face.
6798 The face returned is suitable for displaying ASCII characters. */
6801 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6802 endptr
, limit
, mouse
)
6805 int region_beg
, region_end
;
6810 struct frame
*f
= XFRAME (w
->frame
);
6811 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6812 Lisp_Object prop
, position
;
6814 Lisp_Object
*overlay_vec
;
6817 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6818 Lisp_Object limit1
, end
;
6819 struct face
*default_face
;
6821 /* W must display the current buffer. We could write this function
6822 to use the frame and buffer of W, but right now it doesn't. */
6823 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6825 XSETFRAME (frame
, f
);
6826 XSETFASTINT (position
, pos
);
6829 if (pos
< region_beg
&& region_beg
< endpos
)
6830 endpos
= region_beg
;
6832 /* Get the `face' or `mouse_face' text property at POS, and
6833 determine the next position at which the property changes. */
6834 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6835 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6836 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6838 endpos
= XINT (end
);
6840 /* Look at properties from overlays. */
6845 /* First try with room for 40 overlays. */
6847 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6848 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6849 &next_overlay
, NULL
, 0);
6851 /* If there are more than 40, make enough space for all, and try
6853 if (noverlays
> len
)
6856 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6857 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6858 &next_overlay
, NULL
, 0);
6861 if (next_overlay
< endpos
)
6862 endpos
= next_overlay
;
6867 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6869 /* Optimize common cases where we can use the default face. */
6872 && !(pos
>= region_beg
&& pos
< region_end
))
6873 return DEFAULT_FACE_ID
;
6875 /* Begin with attributes from the default face. */
6876 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6878 /* Merge in attributes specified via text properties. */
6880 merge_face_vector_with_property (f
, attrs
, prop
);
6882 /* Now merge the overlay data. */
6883 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6884 for (i
= 0; i
< noverlays
; i
++)
6889 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6891 merge_face_vector_with_property (f
, attrs
, prop
);
6893 oend
= OVERLAY_END (overlay_vec
[i
]);
6894 oendpos
= OVERLAY_POSITION (oend
);
6895 if (oendpos
< endpos
)
6899 /* If in the region, merge in the region face. */
6900 if (pos
>= region_beg
&& pos
< region_end
)
6902 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6903 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6905 if (region_end
< endpos
)
6906 endpos
= region_end
;
6911 /* Look up a realized face with the given face attributes,
6912 or realize a new one for ASCII characters. */
6913 return lookup_face (f
, attrs
, 0, NULL
);
6917 /* Compute the face at character position POS in Lisp string STRING on
6918 window W, for ASCII characters.
6920 If STRING is an overlay string, it comes from position BUFPOS in
6921 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6922 not an overlay string. W must display the current buffer.
6923 REGION_BEG and REGION_END give the start and end positions of the
6924 region; both are -1 if no region is visible.
6926 BASE_FACE_ID is the id of a face to merge with. For strings coming
6927 from overlays or the `display' property it is the face at BUFPOS.
6929 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6931 Set *ENDPTR to the next position where to check for faces in
6932 STRING; -1 if the face is constant from POS to the end of the
6935 Value is the id of the face to use. The face returned is suitable
6936 for displaying ASCII characters. */
6939 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6940 region_end
, endptr
, base_face_id
, mouse_p
)
6944 int region_beg
, region_end
;
6946 enum face_id base_face_id
;
6949 Lisp_Object prop
, position
, end
, limit
;
6950 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6951 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6952 struct face
*base_face
;
6953 int multibyte_p
= STRING_MULTIBYTE (string
);
6954 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6956 /* Get the value of the face property at the current position within
6957 STRING. Value is nil if there is no face property. */
6958 XSETFASTINT (position
, pos
);
6959 prop
= Fget_text_property (position
, prop_name
, string
);
6961 /* Get the next position at which to check for faces. Value of end
6962 is nil if face is constant all the way to the end of the string.
6963 Otherwise it is a string position where to check faces next.
6964 Limit is the maximum position up to which to check for property
6965 changes in Fnext_single_property_change. Strings are usually
6966 short, so set the limit to the end of the string. */
6967 XSETFASTINT (limit
, XSTRING (string
)->size
);
6968 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6970 *endptr
= XFASTINT (end
);
6974 base_face
= FACE_FROM_ID (f
, base_face_id
);
6975 xassert (base_face
);
6977 /* Optimize the default case that there is no face property and we
6978 are not in the region. */
6980 && (base_face_id
!= DEFAULT_FACE_ID
6981 /* BUFPOS <= 0 means STRING is not an overlay string, so
6982 that the region doesn't have to be taken into account. */
6984 || bufpos
< region_beg
6985 || bufpos
>= region_end
)
6987 /* We can't realize faces for different charsets differently
6988 if we don't have fonts, so we can stop here if not working
6989 on a window-system frame. */
6990 || !FRAME_WINDOW_P (f
)
6991 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6992 return base_face
->id
;
6994 /* Begin with attributes from the base face. */
6995 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6997 /* Merge in attributes specified via text properties. */
6999 merge_face_vector_with_property (f
, attrs
, prop
);
7001 /* If in the region, merge in the region face. */
7003 && bufpos
>= region_beg
7004 && bufpos
< region_end
)
7006 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7007 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7010 /* Look up a realized face with the given face attributes,
7011 or realize a new one for ASCII characters. */
7012 return lookup_face (f
, attrs
, 0, NULL
);
7017 /***********************************************************************
7019 ***********************************************************************/
7023 /* Print the contents of the realized face FACE to stderr. */
7026 dump_realized_face (face
)
7029 fprintf (stderr
, "ID: %d\n", face
->id
);
7030 #ifdef HAVE_X_WINDOWS
7031 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7033 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7035 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7036 fprintf (stderr
, "background: 0x%lx (%s)\n",
7038 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7039 fprintf (stderr
, "font_name: %s (%s)\n",
7041 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7042 #ifdef HAVE_X_WINDOWS
7043 fprintf (stderr
, "font = %p\n", face
->font
);
7045 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7046 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7047 fprintf (stderr
, "underline: %d (%s)\n",
7049 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7050 fprintf (stderr
, "hash: %d\n", face
->hash
);
7051 fprintf (stderr
, "charset: %d\n", face
->charset
);
7055 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7063 fprintf (stderr
, "font selection order: ");
7064 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7065 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7066 fprintf (stderr
, "\n");
7068 fprintf (stderr
, "alternative fonts: ");
7069 debug_print (Vface_alternative_font_family_alist
);
7070 fprintf (stderr
, "\n");
7072 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7073 Fdump_face (make_number (i
));
7079 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7081 error ("Not a valid face");
7082 dump_realized_face (face
);
7089 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7090 0, 0, 0, doc
: /* */)
7093 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7094 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7095 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7099 #endif /* GLYPH_DEBUG != 0 */
7103 /***********************************************************************
7105 ***********************************************************************/
7110 Qface
= intern ("face");
7112 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7113 staticpro (&Qbitmap_spec_p
);
7114 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7115 staticpro (&Qframe_update_face_colors
);
7117 /* Lisp face attribute keywords. */
7118 QCfamily
= intern (":family");
7119 staticpro (&QCfamily
);
7120 QCheight
= intern (":height");
7121 staticpro (&QCheight
);
7122 QCweight
= intern (":weight");
7123 staticpro (&QCweight
);
7124 QCslant
= intern (":slant");
7125 staticpro (&QCslant
);
7126 QCunderline
= intern (":underline");
7127 staticpro (&QCunderline
);
7128 QCinverse_video
= intern (":inverse-video");
7129 staticpro (&QCinverse_video
);
7130 QCreverse_video
= intern (":reverse-video");
7131 staticpro (&QCreverse_video
);
7132 QCforeground
= intern (":foreground");
7133 staticpro (&QCforeground
);
7134 QCbackground
= intern (":background");
7135 staticpro (&QCbackground
);
7136 QCstipple
= intern (":stipple");;
7137 staticpro (&QCstipple
);
7138 QCwidth
= intern (":width");
7139 staticpro (&QCwidth
);
7140 QCfont
= intern (":font");
7141 staticpro (&QCfont
);
7142 QCbold
= intern (":bold");
7143 staticpro (&QCbold
);
7144 QCitalic
= intern (":italic");
7145 staticpro (&QCitalic
);
7146 QCoverline
= intern (":overline");
7147 staticpro (&QCoverline
);
7148 QCstrike_through
= intern (":strike-through");
7149 staticpro (&QCstrike_through
);
7150 QCbox
= intern (":box");
7152 QCinherit
= intern (":inherit");
7153 staticpro (&QCinherit
);
7155 /* Symbols used for Lisp face attribute values. */
7156 QCcolor
= intern (":color");
7157 staticpro (&QCcolor
);
7158 QCline_width
= intern (":line-width");
7159 staticpro (&QCline_width
);
7160 QCstyle
= intern (":style");
7161 staticpro (&QCstyle
);
7162 Qreleased_button
= intern ("released-button");
7163 staticpro (&Qreleased_button
);
7164 Qpressed_button
= intern ("pressed-button");
7165 staticpro (&Qpressed_button
);
7166 Qnormal
= intern ("normal");
7167 staticpro (&Qnormal
);
7168 Qultra_light
= intern ("ultra-light");
7169 staticpro (&Qultra_light
);
7170 Qextra_light
= intern ("extra-light");
7171 staticpro (&Qextra_light
);
7172 Qlight
= intern ("light");
7173 staticpro (&Qlight
);
7174 Qsemi_light
= intern ("semi-light");
7175 staticpro (&Qsemi_light
);
7176 Qsemi_bold
= intern ("semi-bold");
7177 staticpro (&Qsemi_bold
);
7178 Qbold
= intern ("bold");
7180 Qextra_bold
= intern ("extra-bold");
7181 staticpro (&Qextra_bold
);
7182 Qultra_bold
= intern ("ultra-bold");
7183 staticpro (&Qultra_bold
);
7184 Qoblique
= intern ("oblique");
7185 staticpro (&Qoblique
);
7186 Qitalic
= intern ("italic");
7187 staticpro (&Qitalic
);
7188 Qreverse_oblique
= intern ("reverse-oblique");
7189 staticpro (&Qreverse_oblique
);
7190 Qreverse_italic
= intern ("reverse-italic");
7191 staticpro (&Qreverse_italic
);
7192 Qultra_condensed
= intern ("ultra-condensed");
7193 staticpro (&Qultra_condensed
);
7194 Qextra_condensed
= intern ("extra-condensed");
7195 staticpro (&Qextra_condensed
);
7196 Qcondensed
= intern ("condensed");
7197 staticpro (&Qcondensed
);
7198 Qsemi_condensed
= intern ("semi-condensed");
7199 staticpro (&Qsemi_condensed
);
7200 Qsemi_expanded
= intern ("semi-expanded");
7201 staticpro (&Qsemi_expanded
);
7202 Qexpanded
= intern ("expanded");
7203 staticpro (&Qexpanded
);
7204 Qextra_expanded
= intern ("extra-expanded");
7205 staticpro (&Qextra_expanded
);
7206 Qultra_expanded
= intern ("ultra-expanded");
7207 staticpro (&Qultra_expanded
);
7208 Qbackground_color
= intern ("background-color");
7209 staticpro (&Qbackground_color
);
7210 Qforeground_color
= intern ("foreground-color");
7211 staticpro (&Qforeground_color
);
7212 Qunspecified
= intern ("unspecified");
7213 staticpro (&Qunspecified
);
7215 Qface_alias
= intern ("face-alias");
7216 staticpro (&Qface_alias
);
7217 Qdefault
= intern ("default");
7218 staticpro (&Qdefault
);
7219 Qtool_bar
= intern ("tool-bar");
7220 staticpro (&Qtool_bar
);
7221 Qregion
= intern ("region");
7222 staticpro (&Qregion
);
7223 Qfringe
= intern ("fringe");
7224 staticpro (&Qfringe
);
7225 Qheader_line
= intern ("header-line");
7226 staticpro (&Qheader_line
);
7227 Qscroll_bar
= intern ("scroll-bar");
7228 staticpro (&Qscroll_bar
);
7229 Qmenu
= intern ("menu");
7231 Qcursor
= intern ("cursor");
7232 staticpro (&Qcursor
);
7233 Qborder
= intern ("border");
7234 staticpro (&Qborder
);
7235 Qmouse
= intern ("mouse");
7236 staticpro (&Qmouse
);
7237 Qmode_line_inactive
= intern ("mode-line-inactive");
7238 staticpro (&Qmode_line_inactive
);
7239 Qtty_color_desc
= intern ("tty-color-desc");
7240 staticpro (&Qtty_color_desc
);
7241 Qtty_color_by_index
= intern ("tty-color-by-index");
7242 staticpro (&Qtty_color_by_index
);
7243 Qtty_color_alist
= intern ("tty-color-alist");
7244 staticpro (&Qtty_color_alist
);
7245 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7246 staticpro (&Qscalable_fonts_allowed
);
7248 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7249 staticpro (&Vparam_value_alist
);
7250 Vface_alternative_font_family_alist
= Qnil
;
7251 staticpro (&Vface_alternative_font_family_alist
);
7252 Vface_alternative_font_registry_alist
= Qnil
;
7253 staticpro (&Vface_alternative_font_registry_alist
);
7255 defsubr (&Sinternal_make_lisp_face
);
7256 defsubr (&Sinternal_lisp_face_p
);
7257 defsubr (&Sinternal_set_lisp_face_attribute
);
7258 #ifdef HAVE_WINDOW_SYSTEM
7259 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7261 defsubr (&Scolor_gray_p
);
7262 defsubr (&Scolor_supported_p
);
7263 defsubr (&Sface_attribute_relative_p
);
7264 defsubr (&Smerge_face_attribute
);
7265 defsubr (&Sinternal_get_lisp_face_attribute
);
7266 defsubr (&Sinternal_lisp_face_attribute_values
);
7267 defsubr (&Sinternal_lisp_face_equal_p
);
7268 defsubr (&Sinternal_lisp_face_empty_p
);
7269 defsubr (&Sinternal_copy_lisp_face
);
7270 defsubr (&Sinternal_merge_in_global_face
);
7271 defsubr (&Sface_font
);
7272 defsubr (&Sframe_face_alist
);
7273 defsubr (&Sinternal_set_font_selection_order
);
7274 defsubr (&Sinternal_set_alternative_font_family_alist
);
7275 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7276 defsubr (&Sface_attributes_as_vector
);
7278 defsubr (&Sdump_face
);
7279 defsubr (&Sshow_face_resources
);
7280 #endif /* GLYPH_DEBUG */
7281 defsubr (&Sclear_face_cache
);
7282 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7284 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7285 defsubr (&Sdump_colors
);
7288 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7289 doc
: /* *Limit for font matching.
7290 If an integer > 0, font matching functions won't load more than
7291 that number of fonts when searching for a matching font. */);
7292 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7294 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7295 doc
: /* List of global face definitions (for internal use only.) */);
7296 Vface_new_frame_defaults
= Qnil
;
7298 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7299 doc
: /* *Default stipple pattern used on monochrome displays.
7300 This stipple pattern is used on monochrome displays
7301 instead of shades of gray for a face background color.
7302 See `set-face-stipple' for possible values for this variable. */);
7303 Vface_default_stipple
= build_string ("gray3");
7305 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7306 doc
: /* An alist of defined terminal colors and their RGB values. */);
7307 Vtty_defined_color_alist
= Qnil
;
7309 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7310 doc
: /* Allowed scalable fonts.
7311 A value of nil means don't allow any scalable fonts.
7312 A value of t means allow any scalable font.
7313 Otherwise, value must be a list of regular expressions. A font may be
7314 scaled if its name matches a regular expression in the list.
7315 Note that if value is nil, a scalable font might still be used, if no
7316 other font of the appropriate family and registry is available. */);
7317 Vscalable_fonts_allowed
= Qnil
;
7319 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7320 doc
: /* List of ignored fonts.
7321 Each element is a regular expression that matches names of fonts to
7323 Vface_ignored_fonts
= Qnil
;
7325 #ifdef HAVE_WINDOW_SYSTEM
7326 defsubr (&Sbitmap_spec_p
);
7327 defsubr (&Sx_list_fonts
);
7328 defsubr (&Sinternal_face_x_get_resource
);
7329 defsubr (&Sx_family_fonts
);
7330 defsubr (&Sx_font_family_list
);
7331 #endif /* HAVE_WINDOW_SYSTEM */