1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
25 When using Emacs with X, the display style of characters can be
26 changed by defining `faces'. Each face can specify the following
31 2. Relative proportionate width, aka character set width or set
32 width (swidth), e.g. `semi-compressed'.
34 3. Font height in 1/10pt.
36 4. Font weight, e.g. `bold'.
38 5. Font slant, e.g. `italic'.
44 8. Whether or not characters should be underlined, and in what color.
46 9. Whether or not characters should be displayed in inverse video.
48 10. A background stipple, a bitmap.
50 11. Whether or not characters should be overlined, and in what color.
52 12. Whether or not characters should be strike-through, and in what
55 13. Whether or not a box should be drawn around characters, the box
56 type, and, for simple boxes, in what color.
58 14. Font or fontset pattern, or nil. This is a special attribute.
59 When this attribyte is specified, the face uses a font opened by
60 that pattern as is. In addition, all the other font-related
61 attributes (1st thru 5th) are generated from the opened font name.
62 On the other hand, if one of the other font-related attributes are
63 specified, this attribute is set to nil. In that case, the face
64 doesn't inherit this attribute from the `default' face, and uses a
65 font determined by the other attributes (those may be inherited
66 from the `default' face).
68 15. A face name or list of face names from which to inherit attributes.
70 Faces are frame-local by nature because Emacs allows to define the
71 same named face (face names are symbols) differently for different
72 frames. Each frame has an alist of face definitions for all named
73 faces. The value of a named face in such an alist is a Lisp vector
74 with the symbol `face' in slot 0, and a slot for each of the face
75 attributes mentioned above.
77 There is also a global face alist `Vface_new_frame_defaults'. Face
78 definitions from this list are used to initialize faces of newly
81 A face doesn't have to specify all attributes. Those not specified
82 have a value of `unspecified'. Faces specifying all attributes but
83 the 14th are called `fully-specified'.
88 The display style of a given character in the text is determined by
89 combining several faces. This process is called `face merging'.
90 Any aspect of the display style that isn't specified by overlays or
91 text properties is taken from the `default' face. Since it is made
92 sure that the default face is always fully-specified, face merging
93 always results in a fully-specified face.
98 After all face attributes for a character have been determined by
99 merging faces of that character, that face is `realized'. The
100 realization process maps face attributes to what is physically
101 available on the system where Emacs runs. The result is a
102 `realized face' in form of a struct face which is stored in the
103 face cache of the frame on which it was realized.
105 Face realization is done in the context of the character to display
106 because different fonts may be used for different characters. In
107 other words, for characters that have different font
108 specifications, different realized faces are needed to display
111 Font specification is done by fontsets. See the comment in
112 fontset.c for the details. In the current implementation, all ASCII
113 characters share the same font in a fontset.
115 Faces are at first realized for ASCII characters, and, at that
116 time, assigned a specific realized fontset. Hereafter, we call
117 such a face as `ASCII face'. When a face for a multibyte character
118 is realized, it inherits (thus shares) a fontset of an ASCII face
119 that has the same attributes other than font-related ones.
121 Thus, all realzied face have a realized fontset.
126 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
127 font as ASCII characters. That is because it is expected that
128 unibyte text users specify a font that is suitable both for ASCII
129 and raw 8-bit characters.
134 Font selection tries to find the best available matching font for a
135 given (character, face) combination.
137 If the face specifies a fontset name, that fontset determines a
138 pattern for fonts of the given character. If the face specifies a
139 font name or the other font-related attributes, a fontset is
140 realized from the default fontset. In that case, that
141 specification determines a pattern for ASCII characters and the
142 default fontset determines a pattern for multibyte characters.
144 Available fonts on the system on which Emacs runs are then matched
145 against the font pattern. The result of font selection is the best
146 match for the given face attributes in this font list.
148 Font selection can be influenced by the user.
150 1. The user can specify the relative importance he gives the face
151 attributes width, height, weight, and slant by setting
152 face-font-selection-order (faces.el) to a list of face attribute
153 names. The default is '(:width :height :weight :slant), and means
154 that font selection first tries to find a good match for the font
155 width specified by a face, then---within fonts with that
156 width---tries to find a best match for the specified font height,
159 2. Setting face-font-family-alternatives allows the user to
160 specify alternative font families to try if a family specified by a
163 3. Setting face-font-registry-alternatives allows the user to
164 specify all alternative font registries to try for a face
165 specifying a registry.
167 4. Setting face-ignored-fonts allows the user to ignore specific
171 Character compositition.
173 Usually, the realization process is already finished when Emacs
174 actually reflects the desired glyph matrix on the screen. However,
175 on displaying a composition (sequence of characters to be composed
176 on the screen), a suitable font for the components of the
177 composition is selected and realized while drawing them on the
178 screen, i.e. the realization process is delayed but in principle
182 Initialization of basic faces.
184 The faces `default', `modeline' are considered `basic faces'.
185 When redisplay happens the first time for a newly created frame,
186 basic faces are realized for CHARSET_ASCII. Frame parameters are
187 used to fill in unspecified attributes of the default face. */
190 #include <sys/types.h>
191 #include <sys/stat.h>
196 #ifdef HAVE_WINDOW_SYSTEM
198 #endif /* HAVE_WINDOW_SYSTEM */
200 #ifdef HAVE_X_WINDOWS
204 #include <Xm/XmStrDefs.h>
205 #endif /* USE_MOTIF */
206 #endif /* HAVE_X_WINDOWS */
215 /* Redefine X specifics to W32 equivalents to avoid cluttering the
216 code with #ifdef blocks. */
217 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
218 #define x_display_info w32_display_info
219 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
220 #define check_x check_w32
221 #define x_list_fonts w32_list_fonts
222 #define GCGraphicsExposures 0
223 /* For historic reasons, FONT_WIDTH refers to average width on W32,
224 not maximum as on X. Redefine here. */
225 #define FONT_WIDTH FONT_MAX_WIDTH
226 #endif /* WINDOWSNT */
230 #define x_display_info mac_display_info
231 #define check_x check_mac
233 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
236 x_create_gc (f
, mask
, xgcv
)
242 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
251 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
256 #include "dispextern.h"
257 #include "blockinput.h"
259 #include "intervals.h"
261 #ifdef HAVE_X_WINDOWS
263 /* Compensate for a bug in Xos.h on some systems, on which it requires
264 time.h. On some such systems, Xos.h tries to redefine struct
265 timeval and struct timezone if USG is #defined while it is
268 #ifdef XOS_NEEDS_TIME_H
274 #else /* not XOS_NEEDS_TIME_H */
276 #endif /* not XOS_NEEDS_TIME_H */
278 #endif /* HAVE_X_WINDOWS */
282 #include "keyboard.h"
285 #define max(A, B) ((A) > (B) ? (A) : (B))
286 #define min(A, B) ((A) < (B) ? (A) : (B))
287 #define abs(X) ((X) < 0 ? -(X) : (X))
290 /* Number of pt per inch (from the TeXbook). */
292 #define PT_PER_INCH 72.27
294 /* Non-zero if face attribute ATTR is unspecified. */
296 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
298 /* Value is the number of elements of VECTOR. */
300 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
302 /* Make a copy of string S on the stack using alloca. Value is a pointer
305 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
307 /* Make a copy of the contents of Lisp string S on the stack using
308 alloca. Value is a pointer to the copy. */
310 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
312 /* Size of hash table of realized faces in face caches (should be a
315 #define FACE_CACHE_BUCKETS_SIZE 1001
317 /* A definition of XColor for non-X frames. */
319 #ifndef HAVE_X_WINDOWS
324 unsigned short red
, green
, blue
;
330 #endif /* not HAVE_X_WINDOWS */
332 /* Keyword symbols used for face attribute names. */
334 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
335 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
336 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
337 Lisp_Object QCreverse_video
;
338 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
340 /* Symbols used for attribute values. */
342 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
343 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
344 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
345 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
346 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
347 Lisp_Object Qultra_expanded
;
348 Lisp_Object Qreleased_button
, Qpressed_button
;
349 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
350 Lisp_Object Qunspecified
;
352 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
354 /* The name of the function to call when the background of the frame
355 has changed, frame_update_face_colors. */
357 Lisp_Object Qframe_update_face_colors
;
359 /* Names of basic faces. */
361 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
362 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
363 extern Lisp_Object Qmode_line
;
365 /* The symbol `face-alias'. A symbols having that property is an
366 alias for another face. Value of the property is the name of
369 Lisp_Object Qface_alias
;
371 /* Names of frame parameters related to faces. */
373 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
374 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
376 /* Default stipple pattern used on monochrome displays. This stipple
377 pattern is used on monochrome displays instead of shades of gray
378 for a face background color. See `set-face-stipple' for possible
379 values for this variable. */
381 Lisp_Object Vface_default_stipple
;
383 /* Alist of alternative font families. Each element is of the form
384 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
385 try FAMILY1, then FAMILY2, ... */
387 Lisp_Object Vface_alternative_font_family_alist
;
389 /* Alist of alternative font registries. Each element is of the form
390 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
391 loaded, try REGISTRY1, then REGISTRY2, ... */
393 Lisp_Object Vface_alternative_font_registry_alist
;
395 /* Allowed scalable fonts. A value of nil means don't allow any
396 scalable fonts. A value of t means allow the use of any scalable
397 font. Otherwise, value must be a list of regular expressions. A
398 font may be scaled if its name matches a regular expression in the
401 Lisp_Object Vscalable_fonts_allowed
;
403 /* List of regular expressions that matches names of fonts to ignore. */
405 Lisp_Object Vface_ignored_fonts
;
407 /* Maximum number of fonts to consider in font_list. If not an
408 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
410 Lisp_Object Vfont_list_limit
;
411 #define DEFAULT_FONT_LIST_LIMIT 100
413 /* The symbols `foreground-color' and `background-color' which can be
414 used as part of a `face' property. This is for compatibility with
417 Lisp_Object Qforeground_color
, Qbackground_color
;
419 /* The symbols `face' and `mouse-face' used as text properties. */
422 extern Lisp_Object Qmouse_face
;
424 /* Error symbol for wrong_type_argument in load_pixmap. */
426 Lisp_Object Qbitmap_spec_p
;
428 /* Alist of global face definitions. Each element is of the form
429 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
430 is a Lisp vector of face attributes. These faces are used
431 to initialize faces for new frames. */
433 Lisp_Object Vface_new_frame_defaults
;
435 /* The next ID to assign to Lisp faces. */
437 static int next_lface_id
;
439 /* A vector mapping Lisp face Id's to face names. */
441 static Lisp_Object
*lface_id_to_name
;
442 static int lface_id_to_name_size
;
444 /* TTY color-related functions (defined in tty-colors.el). */
446 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
448 /* The name of the function used to compute colors on TTYs. */
450 Lisp_Object Qtty_color_alist
;
452 /* An alist of defined terminal colors and their RGB values. */
454 Lisp_Object Vtty_defined_color_alist
;
456 /* Counter for calls to clear_face_cache. If this counter reaches
457 CLEAR_FONT_TABLE_COUNT, and a frame has more than
458 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
460 static int clear_font_table_count
;
461 #define CLEAR_FONT_TABLE_COUNT 100
462 #define CLEAR_FONT_TABLE_NFONTS 10
464 /* Non-zero means face attributes have been changed since the last
465 redisplay. Used in redisplay_internal. */
467 int face_change_count
;
469 /* Incremented for every change in the `menu' face. */
471 int menu_face_change_count
;
473 /* Non-zero means don't display bold text if a face's foreground
474 and background colors are the inverse of the default colors of the
475 display. This is a kluge to suppress `bold black' foreground text
476 which is hard to read on an LCD monitor. */
478 int tty_suppress_bold_inverse_default_colors_p
;
480 /* A list of the form `((x . y))' used to avoid consing in
481 Finternal_set_lisp_face_attribute. */
483 static Lisp_Object Vparam_value_alist
;
485 /* The total number of colors currently allocated. */
488 static int ncolors_allocated
;
489 static int npixmaps_allocated
;
495 /* Function prototypes. */
500 static void map_tty_color
P_ ((struct frame
*, struct face
*,
501 enum lface_attribute_index
, int *));
502 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
503 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
504 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
505 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
507 static int first_font_matching
P_ ((struct frame
*f
, char *,
508 struct font_name
*));
509 static int x_face_list_fonts
P_ ((struct frame
*, char *,
510 struct font_name
*, int, int, int));
511 static int font_scalable_p
P_ ((struct font_name
*));
512 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
513 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
514 static unsigned char *xstrlwr
P_ ((unsigned char *));
515 static void signal_error
P_ ((char *, Lisp_Object
));
516 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
517 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
518 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
519 static void free_face_colors
P_ ((struct frame
*, struct face
*));
520 static int face_color_gray_p
P_ ((struct frame
*, char *));
521 static char *build_font_name
P_ ((struct font_name
*));
522 static void free_font_names
P_ ((struct font_name
*, int));
523 static int sorted_font_list
P_ ((struct frame
*, char *,
524 int (*cmpfn
) P_ ((const void *, const void *)),
525 struct font_name
**));
526 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
527 Lisp_Object
, struct font_name
**));
528 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
529 Lisp_Object
, struct font_name
**));
530 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
531 Lisp_Object
, Lisp_Object
, struct font_name
**));
532 static int cmp_font_names
P_ ((const void *, const void *));
533 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
534 struct face
*, int));
535 static struct face
*realize_x_face
P_ ((struct face_cache
*,
536 Lisp_Object
*, int, struct face
*));
537 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
538 Lisp_Object
*, int));
539 static int realize_basic_faces
P_ ((struct frame
*));
540 static int realize_default_face
P_ ((struct frame
*));
541 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
542 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
543 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
544 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
545 static unsigned lface_hash
P_ ((Lisp_Object
*));
546 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
547 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
548 static void free_realized_face
P_ ((struct frame
*, struct face
*));
549 static void clear_face_gcs
P_ ((struct face_cache
*));
550 static void free_face_cache
P_ ((struct face_cache
*));
551 static int face_numeric_weight
P_ ((Lisp_Object
));
552 static int face_numeric_slant
P_ ((Lisp_Object
));
553 static int face_numeric_swidth
P_ ((Lisp_Object
));
554 static int face_fontset
P_ ((Lisp_Object
*));
555 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
556 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
557 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
558 Lisp_Object
*, Lisp_Object
));
559 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
561 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
562 Lisp_Object
, int, int));
563 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
564 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
565 static void free_realized_faces
P_ ((struct face_cache
*));
566 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
567 struct font_name
*, int));
568 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
569 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
570 static int xlfd_numeric_slant
P_ ((struct font_name
*));
571 static int xlfd_numeric_weight
P_ ((struct font_name
*));
572 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
573 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
574 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
575 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
576 static int xlfd_fixed_p
P_ ((struct font_name
*));
577 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
579 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
580 struct font_name
*, int,
582 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
583 struct font_name
*, int));
585 #ifdef HAVE_WINDOW_SYSTEM
587 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
588 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
589 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
590 int (*cmpfn
) P_ ((const void *, const void *))));
591 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
592 static void x_free_gc
P_ ((struct frame
*, GC
));
593 static void clear_font_table
P_ ((struct frame
*));
596 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
597 #endif /* WINDOWSNT */
599 #endif /* HAVE_WINDOW_SYSTEM */
602 /***********************************************************************
604 ***********************************************************************/
606 #ifdef HAVE_X_WINDOWS
608 #ifdef DEBUG_X_COLORS
610 /* The following is a poor mans infrastructure for debugging X color
611 allocation problems on displays with PseudoColor-8. Some X servers
612 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
613 color reference counts completely so that they don't signal an
614 error when a color is freed whose reference count is already 0.
615 Other X servers do. To help me debug this, the following code
616 implements a simple reference counting schema of its own, for a
617 single display/screen. --gerd. */
619 /* Reference counts for pixel colors. */
621 int color_count
[256];
623 /* Register color PIXEL as allocated. */
626 register_color (pixel
)
629 xassert (pixel
< 256);
630 ++color_count
[pixel
];
634 /* Register color PIXEL as deallocated. */
637 unregister_color (pixel
)
640 xassert (pixel
< 256);
641 if (color_count
[pixel
] > 0)
642 --color_count
[pixel
];
648 /* Register N colors from PIXELS as deallocated. */
651 unregister_colors (pixels
, n
)
652 unsigned long *pixels
;
656 for (i
= 0; i
< n
; ++i
)
657 unregister_color (pixels
[i
]);
661 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
662 "Dump currently allocated colors and their reference counts to stderr.")
667 fputc ('\n', stderr
);
669 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
672 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
675 fputc ('\n', stderr
);
677 fputc ('\t', stderr
);
681 fputc ('\n', stderr
);
685 #endif /* DEBUG_X_COLORS */
688 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
689 color values. Interrupt input must be blocked when this function
693 x_free_colors (f
, pixels
, npixels
)
695 unsigned long *pixels
;
698 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
700 /* If display has an immutable color map, freeing colors is not
701 necessary and some servers don't allow it. So don't do it. */
702 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
704 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
706 #ifdef DEBUG_X_COLORS
707 unregister_colors (pixels
, npixels
);
713 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
714 color values. Interrupt input must be blocked when this function
718 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
722 unsigned long *pixels
;
725 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
726 int class = dpyinfo
->visual
->class;
728 /* If display has an immutable color map, freeing colors is not
729 necessary and some servers don't allow it. So don't do it. */
730 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
732 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
733 #ifdef DEBUG_X_COLORS
734 unregister_colors (pixels
, npixels
);
740 /* Create and return a GC for use on frame F. GC values and mask
741 are given by XGCV and MASK. */
744 x_create_gc (f
, mask
, xgcv
)
751 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
758 /* Free GC which was used on frame F. */
766 xassert (--ngcs
>= 0);
767 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
771 #endif /* HAVE_X_WINDOWS */
774 /* W32 emulation of GCs */
777 x_create_gc (f
, mask
, xgcv
)
784 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
791 /* Free GC which was used on frame F. */
799 xassert (--ngcs
>= 0);
804 #endif /* WINDOWSNT */
806 /* Like stricmp. Used to compare parts of font names which are in
811 unsigned char *s1
, *s2
;
815 unsigned char c1
= tolower (*s1
);
816 unsigned char c2
= tolower (*s2
);
818 return c1
< c2
? -1 : 1;
823 return *s2
== 0 ? 0 : -1;
828 /* Like strlwr, which might not always be available. */
830 static unsigned char *
834 unsigned char *p
= s
;
843 /* Signal `error' with message S, and additional argument ARG. */
846 signal_error (s
, arg
)
850 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
854 /* If FRAME is nil, return a pointer to the selected frame.
855 Otherwise, check that FRAME is a live frame, and return a pointer
856 to it. NPARAM is the parameter number of FRAME, for
857 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
858 Lisp function definitions. */
860 static INLINE
struct frame
*
861 frame_or_selected_frame (frame
, nparam
)
866 frame
= selected_frame
;
868 CHECK_LIVE_FRAME (frame
, nparam
);
869 return XFRAME (frame
);
873 /***********************************************************************
875 ***********************************************************************/
877 /* Initialize face cache and basic faces for frame F. */
883 /* Make a face cache, if F doesn't have one. */
884 if (FRAME_FACE_CACHE (f
) == NULL
)
885 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
887 #ifdef HAVE_WINDOW_SYSTEM
888 /* Make the image cache. */
889 if (FRAME_WINDOW_P (f
))
891 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
892 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
893 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
895 #endif /* HAVE_WINDOW_SYSTEM */
897 /* Realize basic faces. Must have enough information in frame
898 parameters to realize basic faces at this point. */
899 #ifdef HAVE_X_WINDOWS
900 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
903 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
905 if (!realize_basic_faces (f
))
910 /* Free face cache of frame F. Called from Fdelete_frame. */
916 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
920 free_face_cache (face_cache
);
921 FRAME_FACE_CACHE (f
) = NULL
;
924 #ifdef HAVE_WINDOW_SYSTEM
925 if (FRAME_WINDOW_P (f
))
927 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
930 --image_cache
->refcount
;
931 if (image_cache
->refcount
== 0)
932 free_image_cache (f
);
935 #endif /* HAVE_WINDOW_SYSTEM */
939 /* Clear face caches, and recompute basic faces for frame F. Call
940 this after changing frame parameters on which those faces depend,
941 or when realized faces have been freed due to changing attributes
945 recompute_basic_faces (f
)
948 if (FRAME_FACE_CACHE (f
))
950 clear_face_cache (0);
951 if (!realize_basic_faces (f
))
957 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
958 try to free unused fonts, too. */
961 clear_face_cache (clear_fonts_p
)
964 #ifdef HAVE_WINDOW_SYSTEM
965 Lisp_Object tail
, frame
;
969 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
971 /* From time to time see if we can unload some fonts. This also
972 frees all realized faces on all frames. Fonts needed by
973 faces will be loaded again when faces are realized again. */
974 clear_font_table_count
= 0;
976 FOR_EACH_FRAME (tail
, frame
)
979 if (FRAME_WINDOW_P (f
)
980 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
982 free_all_realized_faces (frame
);
983 clear_font_table (f
);
989 /* Clear GCs of realized faces. */
990 FOR_EACH_FRAME (tail
, frame
)
993 if (FRAME_WINDOW_P (f
))
995 clear_face_gcs (FRAME_FACE_CACHE (f
));
996 clear_image_cache (f
, 0);
1000 #endif /* HAVE_WINDOW_SYSTEM */
1004 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1005 "Clear face caches on all frames.\n\
1006 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
1008 Lisp_Object thorougly
;
1010 clear_face_cache (!NILP (thorougly
));
1011 ++face_change_count
;
1012 ++windows_or_buffers_changed
;
1018 #ifdef HAVE_WINDOW_SYSTEM
1021 /* Remove those fonts from the font table of frame F exept for the
1022 default ASCII font for the frame. Called from clear_face_cache
1023 from time to time. */
1026 clear_font_table (f
)
1029 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1032 xassert (FRAME_WINDOW_P (f
));
1034 /* Free those fonts that are not used by the frame F as the default. */
1035 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1037 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1039 if (!font_info
->name
1040 || font_info
->font
== FRAME_FONT (f
))
1044 if (font_info
->full_name
!= font_info
->name
)
1045 xfree (font_info
->full_name
);
1046 xfree (font_info
->name
);
1048 /* Free the font. */
1050 #ifdef HAVE_X_WINDOWS
1051 XFreeFont (dpyinfo
->display
, font_info
->font
);
1054 w32_unload_font (dpyinfo
, font_info
->font
);
1058 /* Mark font table slot free. */
1059 font_info
->font
= NULL
;
1060 font_info
->name
= font_info
->full_name
= NULL
;
1064 #endif /* HAVE_WINDOW_SYSTEM */
1068 /***********************************************************************
1070 ***********************************************************************/
1072 #ifdef HAVE_WINDOW_SYSTEM
1074 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1075 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1076 A bitmap specification is either a string, a file name, or a list\n\
1077 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1078 HEIGHT is its height, and DATA is a string containing the bits of\n\
1079 the pixmap. Bits are stored row by row, each row occupies\n\
1080 (WIDTH + 7)/8 bytes.")
1086 if (STRINGP (object
))
1087 /* If OBJECT is a string, it's a file name. */
1089 else if (CONSP (object
))
1091 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1092 HEIGHT must be integers > 0, and DATA must be string large
1093 enough to hold a bitmap of the specified size. */
1094 Lisp_Object width
, height
, data
;
1096 height
= width
= data
= Qnil
;
1100 width
= XCAR (object
);
1101 object
= XCDR (object
);
1104 height
= XCAR (object
);
1105 object
= XCDR (object
);
1107 data
= XCAR (object
);
1111 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1113 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1115 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1120 return pixmap_p
? Qt
: Qnil
;
1124 /* Load a bitmap according to NAME (which is either a file name or a
1125 pixmap spec) for use on frame F. Value is the bitmap_id (see
1126 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1127 bitmap cannot be loaded, display a message saying so, and return
1128 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1129 if these pointers are not null. */
1132 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1135 unsigned int *w_ptr
, *h_ptr
;
1143 tem
= Fbitmap_spec_p (name
);
1145 wrong_type_argument (Qbitmap_spec_p
, name
);
1150 /* Decode a bitmap spec into a bitmap. */
1155 w
= XINT (Fcar (name
));
1156 h
= XINT (Fcar (Fcdr (name
)));
1157 bits
= Fcar (Fcdr (Fcdr (name
)));
1159 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1164 /* It must be a string -- a file name. */
1165 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1171 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1182 ++npixmaps_allocated
;
1185 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1188 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1194 #endif /* HAVE_WINDOW_SYSTEM */
1198 /***********************************************************************
1200 ***********************************************************************/
1202 #ifdef HAVE_WINDOW_SYSTEM
1204 /* Update the line_height of frame F. Return non-zero if line height
1208 frame_update_line_height (f
)
1211 int line_height
, changed_p
;
1213 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1214 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1215 FRAME_LINE_HEIGHT (f
) = line_height
;
1219 #endif /* HAVE_WINDOW_SYSTEM */
1222 /***********************************************************************
1224 ***********************************************************************/
1226 #ifdef HAVE_WINDOW_SYSTEM
1228 /* Load font of face FACE which is used on frame F to display
1229 character C. The name of the font to load is determined by lface
1230 and fontset of FACE. */
1233 load_face_font (f
, face
, c
)
1238 struct font_info
*font_info
= NULL
;
1241 face
->font_info_id
= -1;
1244 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1249 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1254 face
->font_info_id
= font_info
->font_idx
;
1255 face
->font
= font_info
->font
;
1256 face
->font_name
= font_info
->full_name
;
1259 x_free_gc (f
, face
->gc
);
1264 add_to_log ("Unable to load font %s",
1265 build_string (font_name
), Qnil
);
1269 #endif /* HAVE_WINDOW_SYSTEM */
1273 /***********************************************************************
1275 ***********************************************************************/
1277 /* A version of defined_color for non-X frames. */
1280 tty_defined_color (f
, color_name
, color_def
, alloc
)
1286 Lisp_Object color_desc
;
1287 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1288 unsigned long red
= 0, green
= 0, blue
= 0;
1291 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1295 XSETFRAME (frame
, f
);
1297 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1298 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1300 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1301 if (CONSP (XCDR (XCDR (color_desc
))))
1303 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1304 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1305 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1309 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1310 /* We were called early during startup, and the colors are not
1311 yet set up in tty-defined-color-alist. Don't return a failure
1312 indication, since this produces the annoying "Unable to
1313 load color" messages in the *Messages* buffer. */
1316 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1318 if (strcmp (color_name
, "unspecified-fg") == 0)
1319 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1320 else if (strcmp (color_name
, "unspecified-bg") == 0)
1321 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1324 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1327 color_def
->pixel
= color_idx
;
1328 color_def
->red
= red
;
1329 color_def
->green
= green
;
1330 color_def
->blue
= blue
;
1336 /* Decide if color named COLOR_NAME is valid for the display
1337 associated with the frame F; if so, return the rgb values in
1338 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1340 This does the right thing for any type of frame. */
1343 defined_color (f
, color_name
, color_def
, alloc
)
1349 if (!FRAME_WINDOW_P (f
))
1350 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1351 #ifdef HAVE_X_WINDOWS
1352 else if (FRAME_X_P (f
))
1353 return x_defined_color (f
, color_name
, color_def
, alloc
);
1356 else if (FRAME_W32_P (f
))
1357 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1360 else if (FRAME_MAC_P (f
))
1361 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1368 /* Given the index IDX of a tty color on frame F, return its name, a
1372 tty_color_name (f
, idx
)
1376 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1379 Lisp_Object coldesc
;
1381 XSETFRAME (frame
, f
);
1382 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1384 if (!NILP (coldesc
))
1385 return XCAR (coldesc
);
1388 /* We can have an MSDOG frame under -nw for a short window of
1389 opportunity before internal_terminal_init is called. DTRT. */
1390 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1391 return msdos_stdcolor_name (idx
);
1394 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1395 return build_string (unspecified_fg
);
1396 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1397 return build_string (unspecified_bg
);
1400 return vga_stdcolor_name (idx
);
1403 return Qunspecified
;
1407 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1408 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1411 face_color_gray_p (f
, color_name
)
1418 if (defined_color (f
, color_name
, &color
, 0))
1419 gray_p
= ((abs (color
.red
- color
.green
)
1420 < max (color
.red
, color
.green
) / 20)
1421 && (abs (color
.green
- color
.blue
)
1422 < max (color
.green
, color
.blue
) / 20)
1423 && (abs (color
.blue
- color
.red
)
1424 < max (color
.blue
, color
.red
) / 20));
1432 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1433 BACKGROUND_P non-zero means the color will be used as background
1437 face_color_supported_p (f
, color_name
, background_p
)
1445 XSETFRAME (frame
, f
);
1446 return (FRAME_WINDOW_P (f
)
1447 ? (!NILP (Fxw_display_color_p (frame
))
1448 || xstricmp (color_name
, "black") == 0
1449 || xstricmp (color_name
, "white") == 0
1451 && face_color_gray_p (f
, color_name
))
1452 || (!NILP (Fx_display_grayscale_p (frame
))
1453 && face_color_gray_p (f
, color_name
)))
1454 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1458 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1459 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1460 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1461 If FRAME is nil or omitted, use the selected frame.")
1463 Lisp_Object color
, frame
;
1467 CHECK_FRAME (frame
, 0);
1468 CHECK_STRING (color
, 0);
1470 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1474 DEFUN ("color-supported-p", Fcolor_supported_p
,
1475 Scolor_supported_p
, 2, 3, 0,
1476 "Return non-nil if COLOR can be displayed on FRAME.\n\
1477 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1478 If FRAME is nil or omitted, use the selected frame.\n\
1479 COLOR must be a valid color name.")
1480 (color
, frame
, background_p
)
1481 Lisp_Object frame
, color
, background_p
;
1485 CHECK_FRAME (frame
, 0);
1486 CHECK_STRING (color
, 0);
1488 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1494 /* Load color with name NAME for use by face FACE on frame F.
1495 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1496 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1497 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1498 pixel color. If color cannot be loaded, display a message, and
1499 return the foreground, background or underline color of F, but
1500 record that fact in flags of the face so that we don't try to free
1504 load_color (f
, face
, name
, target_index
)
1508 enum lface_attribute_index target_index
;
1512 xassert (STRINGP (name
));
1513 xassert (target_index
== LFACE_FOREGROUND_INDEX
1514 || target_index
== LFACE_BACKGROUND_INDEX
1515 || target_index
== LFACE_UNDERLINE_INDEX
1516 || target_index
== LFACE_OVERLINE_INDEX
1517 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1518 || target_index
== LFACE_BOX_INDEX
);
1520 /* if the color map is full, defined_color will return a best match
1521 to the values in an existing cell. */
1522 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1524 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1526 switch (target_index
)
1528 case LFACE_FOREGROUND_INDEX
:
1529 face
->foreground_defaulted_p
= 1;
1530 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1533 case LFACE_BACKGROUND_INDEX
:
1534 face
->background_defaulted_p
= 1;
1535 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1538 case LFACE_UNDERLINE_INDEX
:
1539 face
->underline_defaulted_p
= 1;
1540 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1543 case LFACE_OVERLINE_INDEX
:
1544 face
->overline_color_defaulted_p
= 1;
1545 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1548 case LFACE_STRIKE_THROUGH_INDEX
:
1549 face
->strike_through_color_defaulted_p
= 1;
1550 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1553 case LFACE_BOX_INDEX
:
1554 face
->box_color_defaulted_p
= 1;
1555 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1564 ++ncolors_allocated
;
1571 #ifdef HAVE_WINDOW_SYSTEM
1573 /* Load colors for face FACE which is used on frame F. Colors are
1574 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1575 of ATTRS. If the background color specified is not supported on F,
1576 try to emulate gray colors with a stipple from Vface_default_stipple. */
1579 load_face_colors (f
, face
, attrs
)
1586 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1587 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1589 /* Swap colors if face is inverse-video. */
1590 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1598 /* Check for support for foreground, not for background because
1599 face_color_supported_p is smart enough to know that grays are
1600 "supported" as background because we are supposed to use stipple
1602 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1603 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1605 x_destroy_bitmap (f
, face
->stipple
);
1606 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1607 &face
->pixmap_w
, &face
->pixmap_h
);
1610 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1611 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1615 /* Free color PIXEL on frame F. */
1618 unload_color (f
, pixel
)
1620 unsigned long pixel
;
1622 #ifdef HAVE_X_WINDOWS
1624 x_free_colors (f
, &pixel
, 1);
1630 /* Free colors allocated for FACE. */
1633 free_face_colors (f
, face
)
1637 #ifdef HAVE_X_WINDOWS
1640 if (!face
->foreground_defaulted_p
)
1642 x_free_colors (f
, &face
->foreground
, 1);
1643 IF_DEBUG (--ncolors_allocated
);
1646 if (!face
->background_defaulted_p
)
1648 x_free_colors (f
, &face
->background
, 1);
1649 IF_DEBUG (--ncolors_allocated
);
1652 if (face
->underline_p
1653 && !face
->underline_defaulted_p
)
1655 x_free_colors (f
, &face
->underline_color
, 1);
1656 IF_DEBUG (--ncolors_allocated
);
1659 if (face
->overline_p
1660 && !face
->overline_color_defaulted_p
)
1662 x_free_colors (f
, &face
->overline_color
, 1);
1663 IF_DEBUG (--ncolors_allocated
);
1666 if (face
->strike_through_p
1667 && !face
->strike_through_color_defaulted_p
)
1669 x_free_colors (f
, &face
->strike_through_color
, 1);
1670 IF_DEBUG (--ncolors_allocated
);
1673 if (face
->box
!= FACE_NO_BOX
1674 && !face
->box_color_defaulted_p
)
1676 x_free_colors (f
, &face
->box_color
, 1);
1677 IF_DEBUG (--ncolors_allocated
);
1681 #endif /* HAVE_X_WINDOWS */
1684 #endif /* HAVE_WINDOW_SYSTEM */
1688 /***********************************************************************
1690 ***********************************************************************/
1692 /* An enumerator for each field of an XLFD font name. */
1713 /* An enumerator for each possible slant value of a font. Taken from
1714 the XLFD specification. */
1722 XLFD_SLANT_REVERSE_ITALIC
,
1723 XLFD_SLANT_REVERSE_OBLIQUE
,
1727 /* Relative font weight according to XLFD documentation. */
1731 XLFD_WEIGHT_UNKNOWN
,
1732 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1733 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1734 XLFD_WEIGHT_LIGHT
, /* 30 */
1735 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1736 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1737 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1738 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1739 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1740 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1743 /* Relative proportionate width. */
1747 XLFD_SWIDTH_UNKNOWN
,
1748 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1749 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1750 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1751 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1752 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1753 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1754 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1755 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1756 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1759 /* Structure used for tables mapping XLFD weight, slant, and width
1760 names to numeric and symbolic values. */
1766 Lisp_Object
*symbol
;
1769 /* Table of XLFD slant names and their numeric and symbolic
1770 representations. This table must be sorted by slant names in
1773 static struct table_entry slant_table
[] =
1775 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1776 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1777 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1778 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1779 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1780 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1783 /* Table of XLFD weight names. This table must be sorted by weight
1784 names in ascending order. */
1786 static struct table_entry weight_table
[] =
1788 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1789 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1790 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1791 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1792 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1793 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1794 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1795 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1796 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1797 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1798 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1799 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1800 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1801 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1802 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1803 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1806 /* Table of XLFD width names. This table must be sorted by width
1807 names in ascending order. */
1809 static struct table_entry swidth_table
[] =
1811 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1812 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1813 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1814 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1815 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1816 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1817 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1818 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1819 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1820 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1821 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1822 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1823 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1824 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1825 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1828 /* Structure used to hold the result of splitting font names in XLFD
1829 format into their fields. */
1833 /* The original name which is modified destructively by
1834 split_font_name. The pointer is kept here to be able to free it
1835 if it was allocated from the heap. */
1838 /* Font name fields. Each vector element points into `name' above.
1839 Fields are NUL-terminated. */
1840 char *fields
[XLFD_LAST
];
1842 /* Numeric values for those fields that interest us. See
1843 split_font_name for which these are. */
1844 int numeric
[XLFD_LAST
];
1846 /* Lower value mean higher priority. */
1847 int registry_priority
;
1850 /* The frame in effect when sorting font names. Set temporarily in
1851 sort_fonts so that it is available in font comparison functions. */
1853 static struct frame
*font_frame
;
1855 /* Order by which font selection chooses fonts. The default values
1856 mean `first, find a best match for the font width, then for the
1857 font height, then for weight, then for slant.' This variable can be
1858 set via set-face-font-sort-order. */
1861 static int font_sort_order
[4] = { XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
};
1863 static int font_sort_order
[4];
1866 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1867 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1868 is a pointer to the matching table entry or null if no table entry
1871 static struct table_entry
*
1872 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1873 struct table_entry
*table
;
1875 struct font_name
*font
;
1878 /* Function split_font_name converts fields to lower-case, so there
1879 is no need to use xstrlwr or xstricmp here. */
1880 char *s
= font
->fields
[field_index
];
1881 int low
, mid
, high
, cmp
;
1888 mid
= (low
+ high
) / 2;
1889 cmp
= strcmp (table
[mid
].name
, s
);
1903 /* Return a numeric representation for font name field
1904 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1905 has DIM entries. Value is the numeric value found or DFLT if no
1906 table entry matches. This function is used to translate weight,
1907 slant, and swidth names of XLFD font names to numeric values. */
1910 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1911 struct table_entry
*table
;
1913 struct font_name
*font
;
1917 struct table_entry
*p
;
1918 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1919 return p
? p
->numeric
: dflt
;
1923 /* Return a symbolic representation for font name field
1924 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1925 has DIM entries. Value is the symbolic value found or DFLT if no
1926 table entry matches. This function is used to translate weight,
1927 slant, and swidth names of XLFD font names to symbols. */
1929 static INLINE Lisp_Object
1930 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1931 struct table_entry
*table
;
1933 struct font_name
*font
;
1937 struct table_entry
*p
;
1938 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1939 return p
? *p
->symbol
: dflt
;
1943 /* Return a numeric value for the slant of the font given by FONT. */
1946 xlfd_numeric_slant (font
)
1947 struct font_name
*font
;
1949 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1950 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1954 /* Return a symbol representing the weight of the font given by FONT. */
1956 static INLINE Lisp_Object
1957 xlfd_symbolic_slant (font
)
1958 struct font_name
*font
;
1960 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1961 font
, XLFD_SLANT
, Qnormal
);
1965 /* Return a numeric value for the weight of the font given by FONT. */
1968 xlfd_numeric_weight (font
)
1969 struct font_name
*font
;
1971 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1972 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1976 /* Return a symbol representing the slant of the font given by FONT. */
1978 static INLINE Lisp_Object
1979 xlfd_symbolic_weight (font
)
1980 struct font_name
*font
;
1982 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1983 font
, XLFD_WEIGHT
, Qnormal
);
1987 /* Return a numeric value for the swidth of the font whose XLFD font
1988 name fields are found in FONT. */
1991 xlfd_numeric_swidth (font
)
1992 struct font_name
*font
;
1994 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1995 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1999 /* Return a symbolic value for the swidth of FONT. */
2001 static INLINE Lisp_Object
2002 xlfd_symbolic_swidth (font
)
2003 struct font_name
*font
;
2005 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2006 font
, XLFD_SWIDTH
, Qnormal
);
2010 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2011 entries. Value is a pointer to the matching table entry or null if
2012 no element of TABLE contains SYMBOL. */
2014 static struct table_entry
*
2015 face_value (table
, dim
, symbol
)
2016 struct table_entry
*table
;
2022 xassert (SYMBOLP (symbol
));
2024 for (i
= 0; i
< dim
; ++i
)
2025 if (EQ (*table
[i
].symbol
, symbol
))
2028 return i
< dim
? table
+ i
: NULL
;
2032 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2033 entries. Value is -1 if SYMBOL is not found in TABLE. */
2036 face_numeric_value (table
, dim
, symbol
)
2037 struct table_entry
*table
;
2041 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2042 return p
? p
->numeric
: -1;
2046 /* Return a numeric value representing the weight specified by Lisp
2047 symbol WEIGHT. Value is one of the enumerators of enum
2051 face_numeric_weight (weight
)
2054 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2058 /* Return a numeric value representing the slant specified by Lisp
2059 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2062 face_numeric_slant (slant
)
2065 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2069 /* Return a numeric value representing the swidth specified by Lisp
2070 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2073 face_numeric_swidth (width
)
2076 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2080 #ifdef HAVE_WINDOW_SYSTEM
2082 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2086 struct font_name
*font
;
2088 /* Function split_font_name converts fields to lower-case, so there
2089 is no need to use tolower here. */
2090 return *font
->fields
[XLFD_SPACING
] != 'p';
2094 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2096 The actual height of the font when displayed on F depends on the
2097 resolution of both the font and frame. For example, a 10pt font
2098 designed for a 100dpi display will display larger than 10pt on a
2099 75dpi display. (It's not unusual to use fonts not designed for the
2100 display one is using. For example, some intlfonts are available in
2101 72dpi versions, only.)
2103 Value is the real point size of FONT on frame F, or 0 if it cannot
2107 xlfd_point_size (f
, font
)
2109 struct font_name
*font
;
2111 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2112 double font_pixel
= atoi (font
->fields
[XLFD_PIXEL_SIZE
]);
2115 if (font_pixel
== 0)
2118 real_pt
= PT_PER_INCH
* 10.0 * font_pixel
/ resy
+ 0.5;
2124 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2125 of frame F. This function is used to guess a point size of font
2126 when only the pixel height of the font is available. */
2129 pixel_point_size (f
, pixel
)
2133 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2137 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2138 point size of one dot. */
2139 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2140 int_pt
= real_pt
+ 0.5;
2146 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2147 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2148 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2149 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2150 zero if the font name doesn't have the format we expect. The
2151 expected format is a font name that starts with a `-' and has
2152 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2153 forms of font names where certain field contents are enclosed in
2154 square brackets. We don't support that, for now. */
2157 split_font_name (f
, font
, numeric_p
)
2159 struct font_name
*font
;
2165 if (*font
->name
== '-')
2167 char *p
= xstrlwr (font
->name
) + 1;
2169 while (i
< XLFD_LAST
)
2171 font
->fields
[i
] = p
;
2174 while (*p
&& *p
!= '-')
2184 success_p
= i
== XLFD_LAST
;
2186 /* If requested, and font name was in the expected format,
2187 compute numeric values for some fields. */
2188 if (numeric_p
&& success_p
)
2190 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2191 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2192 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2193 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2194 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2197 /* Initialize it to zero. It will be overridden by font_list while
2198 trying alternate registries. */
2199 font
->registry_priority
= 0;
2205 /* Build an XLFD font name from font name fields in FONT. Value is a
2206 pointer to the font name, which is allocated via xmalloc. */
2209 build_font_name (font
)
2210 struct font_name
*font
;
2214 char *font_name
= (char *) xmalloc (size
);
2215 int total_length
= 0;
2217 for (i
= 0; i
< XLFD_LAST
; ++i
)
2219 /* Add 1 because of the leading `-'. */
2220 int len
= strlen (font
->fields
[i
]) + 1;
2222 /* Reallocate font_name if necessary. Add 1 for the final
2224 if (total_length
+ len
+ 1 >= size
)
2226 int new_size
= max (2 * size
, size
+ len
+ 1);
2227 int sz
= new_size
* sizeof *font_name
;
2228 font_name
= (char *) xrealloc (font_name
, sz
);
2232 font_name
[total_length
] = '-';
2233 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2234 total_length
+= len
;
2237 font_name
[total_length
] = 0;
2242 /* Free an array FONTS of N font_name structures. This frees FONTS
2243 itself and all `name' fields in its elements. */
2246 free_font_names (fonts
, n
)
2247 struct font_name
*fonts
;
2251 xfree (fonts
[--n
].name
);
2256 /* Sort vector FONTS of font_name structures which contains NFONTS
2257 elements using qsort and comparison function CMPFN. F is the frame
2258 on which the fonts will be used. The global variable font_frame
2259 is temporarily set to F to make it available in CMPFN. */
2262 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2264 struct font_name
*fonts
;
2266 int (*cmpfn
) P_ ((const void *, const void *));
2269 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2274 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2275 display in x_display_list. FONTS is a pointer to a vector of
2276 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2277 alternative patterns from Valternate_fontname_alist if no fonts are
2278 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2281 For all fonts found, set FONTS[i].name to the name of the font,
2282 allocated via xmalloc, and split font names into fields. Ignore
2283 fonts that we can't parse. Value is the number of fonts found.
2285 This is similar to x_list_fonts. The differences are:
2287 1. It avoids consing.
2288 2. It never calls XLoadQueryFont. */
2291 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2295 struct font_name
*fonts
;
2296 int nfonts
, try_alternatives_p
;
2297 int scalable_fonts_p
;
2301 #ifdef HAVE_X_WINDOWS
2302 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2304 /* Get the list of fonts matching PATTERN from the X server. */
2306 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2308 #endif /* HAVE_X_WINDOWS */
2309 #if defined (WINDOWSNT) || defined (macintosh)
2310 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2311 better to do it the other way around. */
2313 Lisp_Object lpattern
, tem
;
2318 lpattern
= build_string (pattern
);
2320 /* Get the list of fonts matching PATTERN. */
2323 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2324 #else /* macintosh */
2325 lfonts
= x_list_fonts (f
, lpattern
, 0, nfonts
);
2329 /* Count fonts returned */
2330 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2333 /* Allocate array. */
2335 names
= (char **) xmalloc (n
* sizeof (char *));
2337 /* Extract font names into char * array. */
2339 for (i
= 0; i
< n
; i
++)
2341 names
[i
] = XSTRING (XCAR (tem
))->data
;
2344 #endif /* defined (WINDOWSNT) || defined (macintosh) */
2348 /* Make a copy of the font names we got from X, and
2349 split them into fields. */
2350 for (i
= j
= 0; i
< n
; ++i
)
2352 Lisp_Object elt
, tail
;
2354 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2358 && fast_c_string_match_ignore_case (elt
, names
[i
]) >= 0)
2364 /* Make a copy of the font name. */
2365 fonts
[j
].name
= xstrdup (names
[i
]);
2367 /* Ignore fonts having a name that we can't parse. */
2368 if (!split_font_name (f
, fonts
+ j
, 1))
2369 xfree (fonts
[j
].name
);
2370 else if (font_scalable_p (fonts
+ j
))
2372 if (!scalable_fonts_p
2373 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2374 xfree (fonts
[j
].name
);
2384 #ifdef HAVE_X_WINDOWS
2385 /* Free font names. */
2387 XFreeFontNames (names
);
2393 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2394 if (n
== 0 && try_alternatives_p
)
2396 Lisp_Object list
= Valternate_fontname_alist
;
2398 while (CONSP (list
))
2400 Lisp_Object entry
= XCAR (list
);
2402 && STRINGP (XCAR (entry
))
2403 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2410 Lisp_Object patterns
= XCAR (list
);
2413 while (CONSP (patterns
)
2414 /* If list is screwed up, give up. */
2415 && (name
= XCAR (patterns
),
2417 /* Ignore patterns equal to PATTERN because we tried that
2418 already with no success. */
2419 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2420 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2424 patterns
= XCDR (patterns
);
2432 /* Determine the first font matching PATTERN on frame F. Return in
2433 *FONT the matching font name, split into fields. Value is non-zero
2434 if a match was found. */
2437 first_font_matching (f
, pattern
, font
)
2440 struct font_name
*font
;
2443 struct font_name
*fonts
;
2445 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2446 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2450 bcopy (&fonts
[0], font
, sizeof *font
);
2452 fonts
[0].name
= NULL
;
2453 free_font_names (fonts
, nfonts
);
2460 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2461 using comparison function CMPFN. Value is the number of fonts
2462 found. If value is non-zero, *FONTS is set to a vector of
2463 font_name structures allocated from the heap containing matching
2464 fonts. Each element of *FONTS contains a name member that is also
2465 allocated from the heap. Font names in these structures are split
2466 into fields. Use free_font_names to free such an array. */
2469 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2472 int (*cmpfn
) P_ ((const void *, const void *));
2473 struct font_name
**fonts
;
2477 /* Get the list of fonts matching pattern. 100 should suffice. */
2478 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2479 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2480 nfonts
= XFASTINT (Vfont_list_limit
);
2482 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2483 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2485 /* Sort the resulting array and return it in *FONTS. If no
2486 fonts were found, make sure to set *FONTS to null. */
2488 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2499 /* Compare two font_name structures *A and *B. Value is analogous to
2500 strcmp. Sort order is given by the global variable
2501 font_sort_order. Font names are sorted so that, everything else
2502 being equal, fonts with a resolution closer to that of the frame on
2503 which they are used are listed first. The global variable
2504 font_frame is the frame on which we operate. */
2507 cmp_font_names (a
, b
)
2510 struct font_name
*x
= (struct font_name
*) a
;
2511 struct font_name
*y
= (struct font_name
*) b
;
2514 /* All strings have been converted to lower-case by split_font_name,
2515 so we can use strcmp here. */
2516 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2521 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2523 int j
= font_sort_order
[i
];
2524 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2529 /* Everything else being equal, we prefer fonts with an
2530 y-resolution closer to that of the frame. */
2531 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2532 int x_resy
= x
->numeric
[XLFD_RESY
];
2533 int y_resy
= y
->numeric
[XLFD_RESY
];
2534 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2542 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2543 is non-nil list fonts matching that pattern. Otherwise, if
2544 REGISTRY is non-nil return only fonts with that registry, otherwise
2545 return fonts of any registry. Set *FONTS to a vector of font_name
2546 structures allocated from the heap containing the fonts found.
2547 Value is the number of fonts found. */
2550 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2552 Lisp_Object pattern
, family
, registry
;
2553 struct font_name
**fonts
;
2555 char *pattern_str
, *family_str
, *registry_str
;
2559 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2560 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2562 pattern_str
= (char *) alloca (strlen (family_str
)
2563 + strlen (registry_str
)
2565 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2566 strcat (pattern_str
, family_str
);
2567 strcat (pattern_str
, "-*-");
2568 strcat (pattern_str
, registry_str
);
2569 if (!index (registry_str
, '-'))
2571 if (registry_str
[strlen (registry_str
) - 1] == '*')
2572 strcat (pattern_str
, "-*");
2574 strcat (pattern_str
, "*-*");
2578 pattern_str
= (char *) XSTRING (pattern
)->data
;
2580 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2584 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2585 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2586 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2589 static struct font_name
*
2590 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2591 struct font_name
*fonts1
, *fonts2
;
2592 int nfonts1
, nfonts2
;
2594 int new_nfonts
= nfonts1
+ nfonts2
;
2595 struct font_name
*new_fonts
;
2597 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2598 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2599 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2606 /* Get a sorted list of fonts of family FAMILY on frame F.
2608 If PATTERN is non-nil list fonts matching that pattern.
2610 If REGISTRY is non-nil, return fonts with that registry and the
2611 alternative registries from Vface_alternative_font_registry_alist.
2613 If REGISTRY is nil return fonts of any registry.
2615 Set *FONTS to a vector of font_name structures allocated from the
2616 heap containing the fonts found. Value is the number of fonts
2620 font_list (f
, pattern
, family
, registry
, fonts
)
2622 Lisp_Object pattern
, family
, registry
;
2623 struct font_name
**fonts
;
2625 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2627 if (!NILP (registry
)
2628 && CONSP (Vface_alternative_font_registry_alist
))
2632 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2637 for (alter
= XCDR (alter
), reg_prio
= 1;
2639 alter
= XCDR (alter
), reg_prio
++)
2640 if (STRINGP (XCAR (alter
)))
2643 struct font_name
*fonts2
;
2645 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2647 for (i
= 0; i
< nfonts2
; i
++)
2648 fonts2
[i
].registry_priority
= reg_prio
;
2649 *fonts
= (nfonts
> 0
2650 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2661 /* Remove elements from LIST whose cars are `equal'. Called from
2662 x-family-fonts and x-font-family-list to remove duplicate font
2666 remove_duplicates (list
)
2669 Lisp_Object tail
= list
;
2671 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2673 Lisp_Object next
= XCDR (tail
);
2674 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2675 XCDR (tail
) = XCDR (next
);
2682 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2683 "Return a list of available fonts of family FAMILY on FRAME.\n\
2684 If FAMILY is omitted or nil, list all families.\n\
2685 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2687 If FRAME is omitted or nil, use the selected frame.\n\
2688 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2689 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2690 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2691 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2692 width, weight and slant of the font. These symbols are the same as for\n\
2693 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2694 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2695 giving the registry and encoding of the font.\n\
2696 The result list is sorted according to the current setting of\n\
2697 the face font sort order.")
2699 Lisp_Object family
, frame
;
2701 struct frame
*f
= check_x_frame (frame
);
2702 struct font_name
*fonts
;
2705 struct gcpro gcpro1
;
2708 CHECK_STRING (family
, 1);
2712 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2713 for (i
= nfonts
- 1; i
>= 0; --i
)
2715 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2718 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2719 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2720 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2721 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2722 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2723 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2724 tem
= build_font_name (fonts
+ i
);
2725 ASET (v
, 6, build_string (tem
));
2726 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2727 fonts
[i
].fields
[XLFD_ENCODING
]);
2728 ASET (v
, 7, build_string (tem
));
2731 result
= Fcons (v
, result
);
2734 remove_duplicates (result
);
2735 free_font_names (fonts
, nfonts
);
2741 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2743 "Return a list of available font families on FRAME.\n\
2744 If FRAME is omitted or nil, use the selected frame.\n\
2745 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2746 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2751 struct frame
*f
= check_x_frame (frame
);
2753 struct font_name
*fonts
;
2755 struct gcpro gcpro1
;
2756 int count
= specpdl_ptr
- specpdl
;
2759 /* Let's consider all fonts. Increase the limit for matching
2760 fonts until we have them all. */
2763 specbind (intern ("font-list-limit"), make_number (limit
));
2764 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2766 if (nfonts
== limit
)
2768 free_font_names (fonts
, nfonts
);
2777 for (i
= nfonts
- 1; i
>= 0; --i
)
2778 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2779 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2782 remove_duplicates (result
);
2783 free_font_names (fonts
, nfonts
);
2785 return unbind_to (count
, result
);
2789 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2790 "Return a list of the names of available fonts matching PATTERN.\n\
2791 If optional arguments FACE and FRAME are specified, return only fonts\n\
2792 the same size as FACE on FRAME.\n\
2793 PATTERN is a string, perhaps with wildcard characters;\n\
2794 the * character matches any substring, and\n\
2795 the ? character matches any single character.\n\
2796 PATTERN is case-insensitive.\n\
2797 FACE is a face name--a symbol.\n\
2799 The return value is a list of strings, suitable as arguments to\n\
2802 Fonts Emacs can't use may or may not be excluded\n\
2803 even if they match PATTERN and FACE.\n\
2804 The optional fourth argument MAXIMUM sets a limit on how many\n\
2805 fonts to match. The first MAXIMUM fonts are reported.\n\
2806 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2807 occupied by a character of a font. In that case, return only fonts\n\
2808 the WIDTH times as wide as FACE on FRAME.")
2809 (pattern
, face
, frame
, maximum
, width
)
2810 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2817 CHECK_STRING (pattern
, 0);
2823 CHECK_NATNUM (maximum
, 0);
2824 maxnames
= XINT (maximum
);
2828 CHECK_NUMBER (width
, 4);
2830 /* We can't simply call check_x_frame because this function may be
2831 called before any frame is created. */
2832 f
= frame_or_selected_frame (frame
, 2);
2833 if (!FRAME_WINDOW_P (f
))
2835 /* Perhaps we have not yet created any frame. */
2840 /* Determine the width standard for comparison with the fonts we find. */
2846 /* This is of limited utility since it works with character
2847 widths. Keep it for compatibility. --gerd. */
2848 int face_id
= lookup_named_face (f
, face
, 0);
2849 struct face
*face
= (face_id
< 0
2851 : FACE_FROM_ID (f
, face_id
));
2853 if (face
&& face
->font
)
2854 size
= FONT_WIDTH (face
->font
);
2856 size
= FONT_WIDTH (FRAME_FONT (f
));
2859 size
*= XINT (width
);
2863 Lisp_Object args
[2];
2865 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2867 /* We don't have to check fontsets. */
2869 args
[1] = list_fontsets (f
, pattern
, size
);
2870 return Fnconc (2, args
);
2874 #endif /* HAVE_WINDOW_SYSTEM */
2878 /***********************************************************************
2880 ***********************************************************************/
2882 /* Access face attributes of face FACE, a Lisp vector. */
2884 #define LFACE_FAMILY(LFACE) \
2885 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2886 #define LFACE_HEIGHT(LFACE) \
2887 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2888 #define LFACE_WEIGHT(LFACE) \
2889 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2890 #define LFACE_SLANT(LFACE) \
2891 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2892 #define LFACE_UNDERLINE(LFACE) \
2893 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2894 #define LFACE_INVERSE(LFACE) \
2895 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2896 #define LFACE_FOREGROUND(LFACE) \
2897 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2898 #define LFACE_BACKGROUND(LFACE) \
2899 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2900 #define LFACE_STIPPLE(LFACE) \
2901 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2902 #define LFACE_SWIDTH(LFACE) \
2903 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2904 #define LFACE_OVERLINE(LFACE) \
2905 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2906 #define LFACE_STRIKE_THROUGH(LFACE) \
2907 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2908 #define LFACE_BOX(LFACE) \
2909 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2910 #define LFACE_FONT(LFACE) \
2911 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2912 #define LFACE_INHERIT(LFACE) \
2913 XVECTOR (LFACE)->contents[LFACE_INHERIT_INDEX]
2915 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2916 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2918 #define LFACEP(LFACE) \
2920 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2921 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2926 /* Check consistency of Lisp face attribute vector ATTRS. */
2929 check_lface_attrs (attrs
)
2932 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2933 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2934 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2935 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2936 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2937 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2938 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2939 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2940 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2941 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2942 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2943 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2944 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2945 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2946 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2947 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2948 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2949 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2950 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2951 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2952 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2953 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2954 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2955 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2956 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2957 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2958 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2959 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2960 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2961 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2962 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2963 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2964 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2965 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2966 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2967 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2968 #ifdef HAVE_WINDOW_SYSTEM
2969 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2970 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2971 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2972 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2973 || NILP (attrs
[LFACE_FONT_INDEX
])
2974 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2979 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2987 xassert (LFACEP (lface
));
2988 check_lface_attrs (XVECTOR (lface
)->contents
);
2992 #else /* GLYPH_DEBUG == 0 */
2994 #define check_lface_attrs(attrs) (void) 0
2995 #define check_lface(lface) (void) 0
2997 #endif /* GLYPH_DEBUG == 0 */
3000 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3001 to make it a symvol. If FACE_NAME is an alias for another face,
3002 return that face's name. */
3005 resolve_face_name (face_name
)
3006 Lisp_Object face_name
;
3008 Lisp_Object aliased
;
3010 if (STRINGP (face_name
))
3011 face_name
= intern (XSTRING (face_name
)->data
);
3013 while (SYMBOLP (face_name
))
3015 aliased
= Fget (face_name
, Qface_alias
);
3019 face_name
= aliased
;
3026 /* Return the face definition of FACE_NAME on frame F. F null means
3027 return the definition for new frames. FACE_NAME may be a string or
3028 a symbol (apparently Emacs 20.2 allowed strings as face names in
3029 face text properties; Ediff uses that). If FACE_NAME is an alias
3030 for another face, return that face's definition. If SIGNAL_P is
3031 non-zero, signal an error if FACE_NAME is not a valid face name.
3032 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3035 static INLINE Lisp_Object
3036 lface_from_face_name (f
, face_name
, signal_p
)
3038 Lisp_Object face_name
;
3043 face_name
= resolve_face_name (face_name
);
3046 lface
= assq_no_quit (face_name
, f
->face_alist
);
3048 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3051 lface
= XCDR (lface
);
3053 signal_error ("Invalid face", face_name
);
3055 check_lface (lface
);
3060 /* Get face attributes of face FACE_NAME from frame-local faces on
3061 frame F. Store the resulting attributes in ATTRS which must point
3062 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3063 is non-zero, signal an error if FACE_NAME does not name a face.
3064 Otherwise, value is zero if FACE_NAME is not a face. */
3067 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3069 Lisp_Object face_name
;
3076 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3079 bcopy (XVECTOR (lface
)->contents
, attrs
,
3080 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3090 /* Non-zero if all attributes in face attribute vector ATTRS are
3091 specified, i.e. are non-nil. */
3094 lface_fully_specified_p (attrs
)
3099 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3100 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
3101 if (UNSPECIFIEDP (attrs
[i
]))
3104 return i
== LFACE_VECTOR_SIZE
;
3107 #ifdef HAVE_WINDOW_SYSTEM
3109 /* Set font-related attributes of Lisp face LFACE from the fullname of
3110 the font opened by FONTNAME. If FORCE_P is zero, set only
3111 unspecified attributes of LFACE. The exception is `font'
3112 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3114 If FONTNAME is not available on frame F,
3115 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3116 If the fullname is not in a valid XLFD format,
3117 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3118 in LFACE and return 1.
3119 Otherwise, return 1. */
3122 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3125 Lisp_Object fontname
;
3126 int force_p
, may_fail_p
;
3128 struct font_name font
;
3133 char *font_name
= XSTRING (fontname
)->data
;
3134 struct font_info
*font_info
;
3136 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3137 fontset
= fs_query_fontset (fontname
, 0);
3139 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3141 /* Check if FONT_NAME is surely available on the system. Usually
3142 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3143 returns quickly. But, even if FONT_NAME is not yet cached,
3144 caching it now is not futail because we anyway load the font
3147 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3157 font
.name
= STRDUPA (font_info
->full_name
);
3158 have_xlfd_p
= split_font_name (f
, &font
, 1);
3160 /* Set attributes only if unspecified, otherwise face defaults for
3161 new frames would never take effect. If we couldn't get a font
3162 name conforming to XLFD, set normal values. */
3164 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3169 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3170 + strlen (font
.fields
[XLFD_FOUNDRY
])
3172 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3173 font
.fields
[XLFD_FAMILY
]);
3174 val
= build_string (buffer
);
3177 val
= build_string ("*");
3178 LFACE_FAMILY (lface
) = val
;
3181 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3184 pt
= xlfd_point_size (f
, &font
);
3186 pt
= pixel_point_size (f
, font_info
->height
* 10);
3188 LFACE_HEIGHT (lface
) = make_number (pt
);
3191 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3192 LFACE_SWIDTH (lface
)
3193 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3195 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3196 LFACE_WEIGHT (lface
)
3197 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3199 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3201 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3203 LFACE_FONT (lface
) = fontname
;
3208 #endif /* HAVE_WINDOW_SYSTEM */
3211 /* Merges the face height FROM with the face height TO, and returns the
3212 merged height. If FROM is an invalid height, then INVALID is
3213 returned instead. FROM may be a either an absolute face height or a
3214 `relative' height, and TO must be an absolute height. The returned
3215 value is always an absolute height. GCPRO is a lisp value that will
3216 be protected from garbage-collection if this function makes a call
3220 merge_face_heights (from
, to
, invalid
, gcpro
)
3221 Lisp_Object from
, to
, invalid
, gcpro
;
3225 if (INTEGERP (from
))
3226 result
= XINT (from
);
3227 else if (NUMBERP (from
))
3228 result
= XFLOATINT (from
) * XINT (to
);
3229 #if 0 /* Probably not so useful. */
3230 else if (CONSP (from
) && CONSP (XCDR (from
)))
3232 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3234 if (INTEGERP (XCAR (XCDR (from
))))
3236 int inc
= XINT (XCAR (XCDR (from
)));
3237 if (EQ (XCAR (from
), Qminus
))
3240 result
= XFASTINT (to
);
3241 if (result
+ inc
> 0)
3242 /* Note that `underflows' don't mean FROM is invalid, so
3243 we just pin the result at TO if it would otherwise be
3250 else if (FUNCTIONP (from
))
3252 /* Call function with current height as argument.
3253 From is the new height. */
3254 Lisp_Object args
[2], height
;
3255 struct gcpro gcpro1
;
3261 height
= safe_call (2, args
);
3265 if (NUMBERP (height
))
3266 result
= XFLOATINT (height
);
3270 return make_number (result
);
3276 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3277 store the resulting attributes in TO, which must be already be
3278 completely specified and contain only absolute attributes. Every
3279 specified attribute of FROM overrides the corresponding attribute of
3280 TO; relative attributes in FROM are merged with the absolute value in
3281 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3282 face inheritance; it should be Qnil when called from other places. */
3285 merge_face_vectors (f
, from
, to
, cycle_check
)
3287 Lisp_Object
*from
, *to
;
3288 Lisp_Object cycle_check
;
3292 /* If FROM inherits from some other faces, merge their attributes into
3293 TO before merging FROM's direct attributes. Note that an :inherit
3294 attribute of `unspecified' is the same as one of nil; we never
3295 merge :inherit attributes, so nil is more correct, but lots of
3296 other code uses `unspecified' as a generic value for face attributes. */
3297 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3298 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3299 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3301 /* If TO specifies a :font attribute, and FROM specifies some
3302 font-related attribute, we need to clear TO's :font attribute
3303 (because it will be inconsistent with whatever FROM specifies, and
3304 FROM takes precedence). */
3305 if (!NILP (to
[LFACE_FONT_INDEX
])
3306 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3307 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3308 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3309 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3310 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])))
3311 to
[LFACE_FONT_INDEX
] = Qnil
;
3313 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3314 if (!UNSPECIFIEDP (from
[i
]))
3315 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3316 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3320 /* TO is always an absolute face, which should inherit from nothing.
3321 We blindly copy the :inherit attribute above and fix it up here. */
3322 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3326 /* Checks the `cycle check' variable CHECK to see if it indicates that
3327 EL is part of a cycle; CHECK must be either Qnil or a value returned
3328 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3329 elements after which a cycle might be suspected; after that many
3330 elements, this macro begins consing in order to keep more precise
3333 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3336 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3337 the caller should make sure that's ok. */
3339 #define CYCLE_CHECK(check, el, suspicious) \
3342 : (INTEGERP (check) \
3343 ? (XFASTINT (check) < (suspicious) \
3344 ? make_number (XFASTINT (check) + 1) \
3345 : Fcons (el, Qnil)) \
3346 : (!NILP (Fmemq ((el), (check))) \
3348 : Fcons ((el), (check)))))
3351 /* Merge face attributes from the face on frame F whose name is
3352 INHERITS, into the vector of face attributes TO; INHERITS may also be
3353 a list of face names, in which case they are applied in order.
3354 CYCLE_CHECK is used to detect loops in face inheritance.
3355 Returns true if any of the inherited attributes are `font-related'. */
3358 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3360 Lisp_Object inherit
;
3362 Lisp_Object cycle_check
;
3364 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3365 /* Inherit from the named face INHERIT. */
3369 /* Make sure we're not in an inheritance loop. */
3370 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3371 if (NILP (cycle_check
))
3372 /* Cycle detected, ignore any further inheritance. */
3375 lface
= lface_from_face_name (f
, inherit
, 0);
3377 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3379 else if (CONSP (inherit
))
3380 /* Handle a list of inherited faces by calling ourselves recursively
3381 on each element. Note that we only do so for symbol elements, so
3382 it's not possible to infinitely recurse. */
3384 while (CONSP (inherit
))
3386 if (SYMBOLP (XCAR (inherit
)))
3387 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3389 /* Check for a circular inheritance list. */
3390 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3391 if (NILP (cycle_check
))
3392 /* Cycle detected. */
3395 inherit
= XCDR (inherit
);
3401 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3402 is a face property, determine the resulting face attributes on
3403 frame F, and store them in TO. PROP may be a single face
3404 specification or a list of such specifications. Each face
3405 specification can be
3407 1. A symbol or string naming a Lisp face.
3409 2. A property list of the form (KEYWORD VALUE ...) where each
3410 KEYWORD is a face attribute name, and value is an appropriate value
3413 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3414 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3415 for compatibility with 20.2.
3417 Face specifications earlier in lists take precedence over later
3421 merge_face_vector_with_property (f
, to
, prop
)
3428 Lisp_Object first
= XCAR (prop
);
3430 if (EQ (first
, Qforeground_color
)
3431 || EQ (first
, Qbackground_color
))
3433 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3434 . COLOR). COLOR must be a string. */
3435 Lisp_Object color_name
= XCDR (prop
);
3436 Lisp_Object color
= first
;
3438 if (STRINGP (color_name
))
3440 if (EQ (color
, Qforeground_color
))
3441 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3443 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3446 add_to_log ("Invalid face color", color_name
, Qnil
);
3448 else if (SYMBOLP (first
)
3449 && *XSYMBOL (first
)->name
->data
== ':')
3451 /* Assume this is the property list form. */
3452 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3454 Lisp_Object keyword
= XCAR (prop
);
3455 Lisp_Object value
= XCAR (XCDR (prop
));
3457 if (EQ (keyword
, QCfamily
))
3459 if (STRINGP (value
))
3460 to
[LFACE_FAMILY_INDEX
] = value
;
3462 add_to_log ("Invalid face font family", value
, Qnil
);
3464 else if (EQ (keyword
, QCheight
))
3466 Lisp_Object new_height
=
3467 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3470 if (NILP (new_height
))
3471 add_to_log ("Invalid face font height", value
, Qnil
);
3473 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3475 else if (EQ (keyword
, QCweight
))
3478 && face_numeric_weight (value
) >= 0)
3479 to
[LFACE_WEIGHT_INDEX
] = value
;
3481 add_to_log ("Invalid face weight", value
, Qnil
);
3483 else if (EQ (keyword
, QCslant
))
3486 && face_numeric_slant (value
) >= 0)
3487 to
[LFACE_SLANT_INDEX
] = value
;
3489 add_to_log ("Invalid face slant", value
, Qnil
);
3491 else if (EQ (keyword
, QCunderline
))
3496 to
[LFACE_UNDERLINE_INDEX
] = value
;
3498 add_to_log ("Invalid face underline", value
, Qnil
);
3500 else if (EQ (keyword
, QCoverline
))
3505 to
[LFACE_OVERLINE_INDEX
] = value
;
3507 add_to_log ("Invalid face overline", value
, Qnil
);
3509 else if (EQ (keyword
, QCstrike_through
))
3514 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3516 add_to_log ("Invalid face strike-through", value
, Qnil
);
3518 else if (EQ (keyword
, QCbox
))
3521 value
= make_number (1);
3522 if (INTEGERP (value
)
3526 to
[LFACE_BOX_INDEX
] = value
;
3528 add_to_log ("Invalid face box", value
, Qnil
);
3530 else if (EQ (keyword
, QCinverse_video
)
3531 || EQ (keyword
, QCreverse_video
))
3533 if (EQ (value
, Qt
) || NILP (value
))
3534 to
[LFACE_INVERSE_INDEX
] = value
;
3536 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3538 else if (EQ (keyword
, QCforeground
))
3540 if (STRINGP (value
))
3541 to
[LFACE_FOREGROUND_INDEX
] = value
;
3543 add_to_log ("Invalid face foreground", value
, Qnil
);
3545 else if (EQ (keyword
, QCbackground
))
3547 if (STRINGP (value
))
3548 to
[LFACE_BACKGROUND_INDEX
] = value
;
3550 add_to_log ("Invalid face background", value
, Qnil
);
3552 else if (EQ (keyword
, QCstipple
))
3554 #ifdef HAVE_X_WINDOWS
3555 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3556 if (!NILP (pixmap_p
))
3557 to
[LFACE_STIPPLE_INDEX
] = value
;
3559 add_to_log ("Invalid face stipple", value
, Qnil
);
3562 else if (EQ (keyword
, QCwidth
))
3565 && face_numeric_swidth (value
) >= 0)
3566 to
[LFACE_SWIDTH_INDEX
] = value
;
3568 add_to_log ("Invalid face width", value
, Qnil
);
3570 else if (EQ (keyword
, QCinherit
))
3572 if (SYMBOLP (value
))
3573 to
[LFACE_INHERIT_INDEX
] = value
;
3577 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3578 if (!SYMBOLP (XCAR (tail
)))
3581 to
[LFACE_INHERIT_INDEX
] = value
;
3583 add_to_log ("Invalid face inherit", value
, Qnil
);
3587 add_to_log ("Invalid attribute %s in face property",
3590 prop
= XCDR (XCDR (prop
));
3595 /* This is a list of face specs. Specifications at the
3596 beginning of the list take precedence over later
3597 specifications, so we have to merge starting with the
3598 last specification. */
3599 Lisp_Object next
= XCDR (prop
);
3601 merge_face_vector_with_property (f
, to
, next
);
3602 merge_face_vector_with_property (f
, to
, first
);
3607 /* PROP ought to be a face name. */
3608 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3610 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3612 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3617 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3618 Sinternal_make_lisp_face
, 1, 2, 0,
3619 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3620 If FACE was not known as a face before, create a new one.\n\
3621 If optional argument FRAME is specified, make a frame-local face\n\
3622 for that frame. Otherwise operate on the global face definition.\n\
3623 Value is a vector of face attributes.")
3625 Lisp_Object face
, frame
;
3627 Lisp_Object global_lface
, lface
;
3631 CHECK_SYMBOL (face
, 0);
3632 global_lface
= lface_from_face_name (NULL
, face
, 0);
3636 CHECK_LIVE_FRAME (frame
, 1);
3638 lface
= lface_from_face_name (f
, face
, 0);
3641 f
= NULL
, lface
= Qnil
;
3643 /* Add a global definition if there is none. */
3644 if (NILP (global_lface
))
3646 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3648 XVECTOR (global_lface
)->contents
[0] = Qface
;
3649 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3650 Vface_new_frame_defaults
);
3652 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3653 face id to Lisp face is given by the vector lface_id_to_name.
3654 The mapping from Lisp face to Lisp face id is given by the
3655 property `face' of the Lisp face name. */
3656 if (next_lface_id
== lface_id_to_name_size
)
3658 int new_size
= max (50, 2 * lface_id_to_name_size
);
3659 int sz
= new_size
* sizeof *lface_id_to_name
;
3660 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3661 lface_id_to_name_size
= new_size
;
3664 lface_id_to_name
[next_lface_id
] = face
;
3665 Fput (face
, Qface
, make_number (next_lface_id
));
3669 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3670 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3672 /* Add a frame-local definition. */
3677 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3679 XVECTOR (lface
)->contents
[0] = Qface
;
3680 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3683 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3684 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3687 lface
= global_lface
;
3689 xassert (LFACEP (lface
));
3690 check_lface (lface
);
3695 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3696 Sinternal_lisp_face_p
, 1, 2, 0,
3697 "Return non-nil if FACE names a face.\n\
3698 If optional second parameter FRAME is non-nil, check for the\n\
3699 existence of a frame-local face with name FACE on that frame.\n\
3700 Otherwise check for the existence of a global face.")
3702 Lisp_Object face
, frame
;
3708 CHECK_LIVE_FRAME (frame
, 1);
3709 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3712 lface
= lface_from_face_name (NULL
, face
, 0);
3718 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3719 Sinternal_copy_lisp_face
, 4, 4, 0,
3720 "Copy face FROM to TO.\n\
3721 If FRAME it t, copy the global face definition of FROM to the\n\
3722 global face definition of TO. Otherwise, copy the frame-local\n\
3723 definition of FROM on FRAME to the frame-local definition of TO\n\
3724 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3727 (from
, to
, frame
, new_frame
)
3728 Lisp_Object from
, to
, frame
, new_frame
;
3730 Lisp_Object lface
, copy
;
3732 CHECK_SYMBOL (from
, 0);
3733 CHECK_SYMBOL (to
, 1);
3734 if (NILP (new_frame
))
3739 /* Copy global definition of FROM. We don't make copies of
3740 strings etc. because 20.2 didn't do it either. */
3741 lface
= lface_from_face_name (NULL
, from
, 1);
3742 copy
= Finternal_make_lisp_face (to
, Qnil
);
3746 /* Copy frame-local definition of FROM. */
3747 CHECK_LIVE_FRAME (frame
, 2);
3748 CHECK_LIVE_FRAME (new_frame
, 3);
3749 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3750 copy
= Finternal_make_lisp_face (to
, new_frame
);
3753 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3754 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3760 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3761 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3762 "Set attribute ATTR of FACE to VALUE.\n\
3763 FRAME being a frame means change the face on that frame.\n\
3764 FRAME nil means change change the face of the selected frame.\n\
3765 FRAME t means change the default for new frames.\n\
3766 FRAME 0 means change the face on all frames, and change the default\n\
3768 (face
, attr
, value
, frame
)
3769 Lisp_Object face
, attr
, value
, frame
;
3772 Lisp_Object old_value
= Qnil
;
3773 /* Set 1 if ATTR is QCfont. */
3774 int font_attr_p
= 0;
3775 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3776 int font_related_attr_p
= 0;
3778 CHECK_SYMBOL (face
, 0);
3779 CHECK_SYMBOL (attr
, 1);
3781 face
= resolve_face_name (face
);
3783 /* If FRAME is 0, change face on all frames, and change the
3784 default for new frames. */
3785 if (INTEGERP (frame
) && XINT (frame
) == 0)
3788 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3789 FOR_EACH_FRAME (tail
, frame
)
3790 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3794 /* Set lface to the Lisp attribute vector of FACE. */
3796 lface
= lface_from_face_name (NULL
, face
, 1);
3800 frame
= selected_frame
;
3802 CHECK_LIVE_FRAME (frame
, 3);
3803 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3805 /* If a frame-local face doesn't exist yet, create one. */
3807 lface
= Finternal_make_lisp_face (face
, frame
);
3810 if (EQ (attr
, QCfamily
))
3812 if (!UNSPECIFIEDP (value
))
3814 CHECK_STRING (value
, 3);
3815 if (XSTRING (value
)->size
== 0)
3816 signal_error ("Invalid face family", value
);
3818 old_value
= LFACE_FAMILY (lface
);
3819 LFACE_FAMILY (lface
) = value
;
3820 font_related_attr_p
= 1;
3822 else if (EQ (attr
, QCheight
))
3824 if (!UNSPECIFIEDP (value
))
3827 (EQ (face
, Qdefault
) ? value
:
3828 /* The default face must have an absolute size, otherwise, we do
3829 a test merge with a random height to see if VALUE's ok. */
3830 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3832 if (!INTEGERP(test
) || XINT(test
) <= 0)
3833 signal_error ("Invalid face height", value
);
3836 old_value
= LFACE_HEIGHT (lface
);
3837 LFACE_HEIGHT (lface
) = value
;
3838 font_related_attr_p
= 1;
3840 else if (EQ (attr
, QCweight
))
3842 if (!UNSPECIFIEDP (value
))
3844 CHECK_SYMBOL (value
, 3);
3845 if (face_numeric_weight (value
) < 0)
3846 signal_error ("Invalid face weight", value
);
3848 old_value
= LFACE_WEIGHT (lface
);
3849 LFACE_WEIGHT (lface
) = value
;
3850 font_related_attr_p
= 1;
3852 else if (EQ (attr
, QCslant
))
3854 if (!UNSPECIFIEDP (value
))
3856 CHECK_SYMBOL (value
, 3);
3857 if (face_numeric_slant (value
) < 0)
3858 signal_error ("Invalid face slant", value
);
3860 old_value
= LFACE_SLANT (lface
);
3861 LFACE_SLANT (lface
) = value
;
3862 font_related_attr_p
= 1;
3864 else if (EQ (attr
, QCunderline
))
3866 if (!UNSPECIFIEDP (value
))
3867 if ((SYMBOLP (value
)
3869 && !EQ (value
, Qnil
))
3870 /* Underline color. */
3872 && XSTRING (value
)->size
== 0))
3873 signal_error ("Invalid face underline", value
);
3875 old_value
= LFACE_UNDERLINE (lface
);
3876 LFACE_UNDERLINE (lface
) = value
;
3878 else if (EQ (attr
, QCoverline
))
3880 if (!UNSPECIFIEDP (value
))
3881 if ((SYMBOLP (value
)
3883 && !EQ (value
, Qnil
))
3884 /* Overline color. */
3886 && XSTRING (value
)->size
== 0))
3887 signal_error ("Invalid face overline", value
);
3889 old_value
= LFACE_OVERLINE (lface
);
3890 LFACE_OVERLINE (lface
) = value
;
3892 else if (EQ (attr
, QCstrike_through
))
3894 if (!UNSPECIFIEDP (value
))
3895 if ((SYMBOLP (value
)
3897 && !EQ (value
, Qnil
))
3898 /* Strike-through color. */
3900 && XSTRING (value
)->size
== 0))
3901 signal_error ("Invalid face strike-through", value
);
3903 old_value
= LFACE_STRIKE_THROUGH (lface
);
3904 LFACE_STRIKE_THROUGH (lface
) = value
;
3906 else if (EQ (attr
, QCbox
))
3910 /* Allow t meaning a simple box of width 1 in foreground color
3913 value
= make_number (1);
3915 if (UNSPECIFIEDP (value
))
3917 else if (NILP (value
))
3919 else if (INTEGERP (value
))
3920 valid_p
= XINT (value
) > 0;
3921 else if (STRINGP (value
))
3922 valid_p
= XSTRING (value
)->size
> 0;
3923 else if (CONSP (value
))
3939 if (EQ (k
, QCline_width
))
3941 if (!INTEGERP (v
) || XINT (v
) <= 0)
3944 else if (EQ (k
, QCcolor
))
3946 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3949 else if (EQ (k
, QCstyle
))
3951 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3958 valid_p
= NILP (tem
);
3964 signal_error ("Invalid face box", value
);
3966 old_value
= LFACE_BOX (lface
);
3967 LFACE_BOX (lface
) = value
;
3969 else if (EQ (attr
, QCinverse_video
)
3970 || EQ (attr
, QCreverse_video
))
3972 if (!UNSPECIFIEDP (value
))
3974 CHECK_SYMBOL (value
, 3);
3975 if (!EQ (value
, Qt
) && !NILP (value
))
3976 signal_error ("Invalid inverse-video face attribute value", value
);
3978 old_value
= LFACE_INVERSE (lface
);
3979 LFACE_INVERSE (lface
) = value
;
3981 else if (EQ (attr
, QCforeground
))
3983 if (!UNSPECIFIEDP (value
))
3985 /* Don't check for valid color names here because it depends
3986 on the frame (display) whether the color will be valid
3987 when the face is realized. */
3988 CHECK_STRING (value
, 3);
3989 if (XSTRING (value
)->size
== 0)
3990 signal_error ("Empty foreground color value", value
);
3992 old_value
= LFACE_FOREGROUND (lface
);
3993 LFACE_FOREGROUND (lface
) = value
;
3995 else if (EQ (attr
, QCbackground
))
3997 if (!UNSPECIFIEDP (value
))
3999 /* Don't check for valid color names here because it depends
4000 on the frame (display) whether the color will be valid
4001 when the face is realized. */
4002 CHECK_STRING (value
, 3);
4003 if (XSTRING (value
)->size
== 0)
4004 signal_error ("Empty background color value", value
);
4006 old_value
= LFACE_BACKGROUND (lface
);
4007 LFACE_BACKGROUND (lface
) = value
;
4009 else if (EQ (attr
, QCstipple
))
4011 #ifdef HAVE_X_WINDOWS
4012 if (!UNSPECIFIEDP (value
)
4014 && NILP (Fbitmap_spec_p (value
)))
4015 signal_error ("Invalid stipple attribute", value
);
4016 old_value
= LFACE_STIPPLE (lface
);
4017 LFACE_STIPPLE (lface
) = value
;
4018 #endif /* HAVE_X_WINDOWS */
4020 else if (EQ (attr
, QCwidth
))
4022 if (!UNSPECIFIEDP (value
))
4024 CHECK_SYMBOL (value
, 3);
4025 if (face_numeric_swidth (value
) < 0)
4026 signal_error ("Invalid face width", value
);
4028 old_value
= LFACE_SWIDTH (lface
);
4029 LFACE_SWIDTH (lface
) = value
;
4030 font_related_attr_p
= 1;
4032 else if (EQ (attr
, QCfont
))
4034 #ifdef HAVE_WINDOW_SYSTEM
4035 /* Set font-related attributes of the Lisp face from an
4040 CHECK_STRING (value
, 3);
4042 f
= SELECTED_FRAME ();
4044 f
= check_x_frame (frame
);
4046 /* VALUE may be a fontset name or an alias of fontset. In such
4047 a case, use the base fontset name. */
4048 tmp
= Fquery_fontset (value
, Qnil
);
4052 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4053 signal_error ("Invalid font or fontset name", value
);
4056 #endif /* HAVE_WINDOW_SYSTEM */
4058 else if (EQ (attr
, QCinherit
))
4061 if (SYMBOLP (value
))
4064 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4065 if (!SYMBOLP (XCAR (tail
)))
4068 LFACE_INHERIT (lface
) = value
;
4070 signal_error ("Invalid face inheritance", value
);
4072 else if (EQ (attr
, QCbold
))
4074 old_value
= LFACE_WEIGHT (lface
);
4075 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4076 font_related_attr_p
= 1;
4078 else if (EQ (attr
, QCitalic
))
4080 old_value
= LFACE_SLANT (lface
);
4081 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4082 font_related_attr_p
= 1;
4085 signal_error ("Invalid face attribute name", attr
);
4087 if (font_related_attr_p
4088 && !UNSPECIFIEDP (value
))
4089 /* If a font-related attribute other than QCfont is specified, the
4090 original `font' attribute nor that of default face is useless
4091 to determine a new font. Thus, we set it to nil so that font
4092 selection mechanism doesn't use it. */
4093 LFACE_FONT (lface
) = Qnil
;
4095 /* Changing a named face means that all realized faces depending on
4096 that face are invalid. Since we cannot tell which realized faces
4097 depend on the face, make sure they are all removed. This is done
4098 by incrementing face_change_count. The next call to
4099 init_iterator will then free realized faces. */
4101 && (EQ (attr
, QCfont
)
4102 || NILP (Fequal (old_value
, value
))))
4104 ++face_change_count
;
4105 ++windows_or_buffers_changed
;
4108 #ifdef HAVE_WINDOW_SYSTEM
4110 if (!UNSPECIFIEDP (value
)
4111 && NILP (Fequal (old_value
, value
)))
4117 if (EQ (face
, Qdefault
))
4119 /* Changed font-related attributes of the `default' face are
4120 reflected in changed `font' frame parameters. */
4121 if ((font_related_attr_p
|| font_attr_p
)
4122 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4123 set_font_frame_param (frame
, lface
);
4124 else if (EQ (attr
, QCforeground
))
4125 param
= Qforeground_color
;
4126 else if (EQ (attr
, QCbackground
))
4127 param
= Qbackground_color
;
4130 else if (EQ (face
, Qscroll_bar
))
4132 /* Changing the colors of `scroll-bar' sets frame parameters
4133 `scroll-bar-foreground' and `scroll-bar-background'. */
4134 if (EQ (attr
, QCforeground
))
4135 param
= Qscroll_bar_foreground
;
4136 else if (EQ (attr
, QCbackground
))
4137 param
= Qscroll_bar_background
;
4139 #endif /* not WINDOWSNT */
4140 else if (EQ (face
, Qborder
))
4142 /* Changing background color of `border' sets frame parameter
4144 if (EQ (attr
, QCbackground
))
4145 param
= Qborder_color
;
4147 else if (EQ (face
, Qcursor
))
4149 /* Changing background color of `cursor' sets frame parameter
4151 if (EQ (attr
, QCbackground
))
4152 param
= Qcursor_color
;
4154 else if (EQ (face
, Qmouse
))
4156 /* Changing background color of `mouse' sets frame parameter
4158 if (EQ (attr
, QCbackground
))
4159 param
= Qmouse_color
;
4161 else if (EQ (face
, Qmenu
))
4162 ++menu_face_change_count
;
4166 /* Update `default-frame-alist', which is used for new frames. */
4168 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4171 /* Update the current frame's parameters. */
4174 cons
= XCAR (Vparam_value_alist
);
4175 XCAR (cons
) = param
;
4176 XCDR (cons
) = value
;
4177 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4181 #endif /* HAVE_WINDOW_SYSTEM */
4187 #ifdef HAVE_WINDOW_SYSTEM
4189 /* Set the `font' frame parameter of FRAME determined from `default'
4190 face attributes LFACE. If a face or fontset name is explicitely
4191 specfied in LFACE, use it as is. Otherwise, determine a font name
4192 from the other font-related atrributes of LFACE. In that case, if
4193 there's no matching font, signals an error. */
4196 set_font_frame_param (frame
, lface
)
4197 Lisp_Object frame
, lface
;
4199 struct frame
*f
= XFRAME (frame
);
4200 Lisp_Object font_name
;
4203 if (STRINGP (LFACE_FONT (lface
)))
4204 font_name
= LFACE_FONT (lface
);
4207 /* Choose a font name that reflects LFACE's attributes and has
4208 the registry and encoding pattern specified in the default
4209 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4210 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4212 error ("No font matches the specified attribute");
4213 font_name
= build_string (font
);
4217 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4221 /* Update the corresponding face when frame parameter PARAM on frame F
4222 has been assigned the value NEW_VALUE. */
4225 update_face_from_frame_parameter (f
, param
, new_value
)
4227 Lisp_Object param
, new_value
;
4231 /* If there are no faces yet, give up. This is the case when called
4232 from Fx_create_frame, and we do the necessary things later in
4233 face-set-after-frame-defaults. */
4234 if (NILP (f
->face_alist
))
4237 if (EQ (param
, Qforeground_color
))
4239 lface
= lface_from_face_name (f
, Qdefault
, 1);
4240 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4241 ? new_value
: Qunspecified
);
4242 realize_basic_faces (f
);
4244 else if (EQ (param
, Qbackground_color
))
4248 /* Changing the background color might change the background
4249 mode, so that we have to load new defface specs. Call
4250 frame-update-face-colors to do that. */
4251 XSETFRAME (frame
, f
);
4252 call1 (Qframe_update_face_colors
, frame
);
4254 lface
= lface_from_face_name (f
, Qdefault
, 1);
4255 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4256 ? new_value
: Qunspecified
);
4257 realize_basic_faces (f
);
4259 if (EQ (param
, Qborder_color
))
4261 lface
= lface_from_face_name (f
, Qborder
, 1);
4262 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4263 ? new_value
: Qunspecified
);
4265 else if (EQ (param
, Qcursor_color
))
4267 lface
= lface_from_face_name (f
, Qcursor
, 1);
4268 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4269 ? new_value
: Qunspecified
);
4271 else if (EQ (param
, Qmouse_color
))
4273 lface
= lface_from_face_name (f
, Qmouse
, 1);
4274 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4275 ? new_value
: Qunspecified
);
4280 /* Get the value of X resource RESOURCE, class CLASS for the display
4281 of frame FRAME. This is here because ordinary `x-get-resource'
4282 doesn't take a frame argument. */
4284 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4285 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4286 (resource
, class, frame
)
4287 Lisp_Object resource
, class, frame
;
4289 Lisp_Object value
= Qnil
;
4292 CHECK_STRING (resource
, 0);
4293 CHECK_STRING (class, 1);
4294 CHECK_LIVE_FRAME (frame
, 2);
4296 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4297 resource
, class, Qnil
, Qnil
);
4299 #endif /* not macintosh */
4300 #endif /* not WINDOWSNT */
4305 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4306 If VALUE is "on" or "true", return t. If VALUE is "off" or
4307 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4308 error; if SIGNAL_P is zero, return 0. */
4311 face_boolean_x_resource_value (value
, signal_p
)
4315 Lisp_Object result
= make_number (0);
4317 xassert (STRINGP (value
));
4319 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4320 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4322 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4323 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4325 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4326 result
= Qunspecified
;
4328 signal_error ("Invalid face attribute value from X resource", value
);
4334 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4335 Finternal_set_lisp_face_attribute_from_resource
,
4336 Sinternal_set_lisp_face_attribute_from_resource
,
4338 (face
, attr
, value
, frame
)
4339 Lisp_Object face
, attr
, value
, frame
;
4341 CHECK_SYMBOL (face
, 0);
4342 CHECK_SYMBOL (attr
, 1);
4343 CHECK_STRING (value
, 2);
4345 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4346 value
= Qunspecified
;
4347 else if (EQ (attr
, QCheight
))
4349 value
= Fstring_to_number (value
, make_number (10));
4350 if (XINT (value
) <= 0)
4351 signal_error ("Invalid face height from X resource", value
);
4353 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4354 value
= face_boolean_x_resource_value (value
, 1);
4355 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4356 value
= intern (XSTRING (value
)->data
);
4357 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4358 value
= face_boolean_x_resource_value (value
, 1);
4359 else if (EQ (attr
, QCunderline
)
4360 || EQ (attr
, QCoverline
)
4361 || EQ (attr
, QCstrike_through
)
4362 || EQ (attr
, QCbox
))
4364 Lisp_Object boolean_value
;
4366 /* If the result of face_boolean_x_resource_value is t or nil,
4367 VALUE does NOT specify a color. */
4368 boolean_value
= face_boolean_x_resource_value (value
, 0);
4369 if (SYMBOLP (boolean_value
))
4370 value
= boolean_value
;
4373 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4376 #endif /* HAVE_WINDOW_SYSTEM */
4379 #ifdef HAVE_X_WINDOWS
4380 /***********************************************************************
4382 ***********************************************************************/
4384 #ifdef USE_X_TOOLKIT
4386 #include "../lwlib/lwlib-utils.h"
4388 /* Structure used to pass X resources to functions called via
4389 XtApplyToWidgets. */
4400 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
4401 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4404 /* Set widget W's X resources from P which points to an x_resources
4405 structure. If W is a cascade button, apply resources to W's
4409 xm_apply_resources (w
, p
)
4414 struct x_resources
*res
= (struct x_resources
*) p
;
4416 XtSetValues (w
, res
->av
, res
->ac
);
4417 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
4420 XtSetValues (submenu
, res
->av
, res
->ac
);
4421 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
4426 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
4427 This is the LessTif/Motif version. As of LessTif 0.88 it has the
4430 1. Setting the XmNfontList resource leads to an infinite loop
4431 somewhere in LessTif. */
4434 xm_set_menu_resources_from_menu_face (f
, widget
)
4444 lface
= lface_from_face_name (f
, Qmenu
, 1);
4445 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4447 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4449 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4453 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4455 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4459 /* If any font-related attribute of `menu' is set, set the font. */
4461 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4462 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4463 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4464 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4465 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4467 #if 0 /* Setting the font leads to an infinite loop somewhere
4468 in LessTif during geometry computation. */
4470 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4471 fl
= XmFontListAppendEntry (NULL
, fe
);
4472 XtSetArg (av
[ac
], XmNfontList
, fl
);
4477 xassert (ac
<= sizeof av
/ sizeof *av
);
4481 struct x_resources res
;
4483 XtSetValues (widget
, av
, ac
);
4484 res
.av
= av
, res
.ac
= ac
;
4485 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4487 XmFontListFree (fl
);
4491 #endif /* USE_MOTIF */
4495 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4496 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4499 /* Set widget W's resources from P which points to an x_resources
4503 xl_apply_resources (widget
, p
)
4507 struct x_resources
*res
= (struct x_resources
*) p
;
4508 XtSetValues (widget
, res
->av
, res
->ac
);
4512 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4513 This is the Lucid version. */
4516 xl_set_menu_resources_from_menu_face (f
, widget
)
4525 lface
= lface_from_face_name (f
, Qmenu
, 1);
4526 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4528 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4530 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4534 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4536 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4541 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4542 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4543 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4544 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4545 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4547 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4553 struct x_resources res
;
4555 XtSetValues (widget
, av
, ac
);
4557 /* We must do children here in case we're handling a pop-up menu
4558 in which case WIDGET is a popup shell. XtApplyToWidgets
4559 is a function from lwlib. */
4560 res
.av
= av
, res
.ac
= ac
;
4561 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4565 #endif /* USE_LUCID */
4568 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4571 x_set_menu_resources_from_menu_face (f
, widget
)
4575 /* Realized faces may have been removed on frame F, e.g. because of
4576 face attribute changes. Recompute them, if necessary, since we
4577 will need the `menu' face. */
4578 if (f
->face_cache
->used
== 0)
4579 recompute_basic_faces (f
);
4583 xl_set_menu_resources_from_menu_face (f
, widget
);
4586 xm_set_menu_resources_from_menu_face (f
, widget
);
4591 #endif /* USE_X_TOOLKIT */
4593 #endif /* HAVE_X_WINDOWS */
4597 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4598 Sinternal_get_lisp_face_attribute
,
4600 "Return face attribute KEYWORD of face SYMBOL.\n\
4601 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4602 face attribute name, signal an error.\n\
4603 If the optional argument FRAME is given, report on face FACE in that\n\
4604 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4605 frames). If FRAME is omitted or nil, use the selected frame.")
4606 (symbol
, keyword
, frame
)
4607 Lisp_Object symbol
, keyword
, frame
;
4609 Lisp_Object lface
, value
= Qnil
;
4611 CHECK_SYMBOL (symbol
, 0);
4612 CHECK_SYMBOL (keyword
, 1);
4615 lface
= lface_from_face_name (NULL
, symbol
, 1);
4619 frame
= selected_frame
;
4620 CHECK_LIVE_FRAME (frame
, 2);
4621 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4624 if (EQ (keyword
, QCfamily
))
4625 value
= LFACE_FAMILY (lface
);
4626 else if (EQ (keyword
, QCheight
))
4627 value
= LFACE_HEIGHT (lface
);
4628 else if (EQ (keyword
, QCweight
))
4629 value
= LFACE_WEIGHT (lface
);
4630 else if (EQ (keyword
, QCslant
))
4631 value
= LFACE_SLANT (lface
);
4632 else if (EQ (keyword
, QCunderline
))
4633 value
= LFACE_UNDERLINE (lface
);
4634 else if (EQ (keyword
, QCoverline
))
4635 value
= LFACE_OVERLINE (lface
);
4636 else if (EQ (keyword
, QCstrike_through
))
4637 value
= LFACE_STRIKE_THROUGH (lface
);
4638 else if (EQ (keyword
, QCbox
))
4639 value
= LFACE_BOX (lface
);
4640 else if (EQ (keyword
, QCinverse_video
)
4641 || EQ (keyword
, QCreverse_video
))
4642 value
= LFACE_INVERSE (lface
);
4643 else if (EQ (keyword
, QCforeground
))
4644 value
= LFACE_FOREGROUND (lface
);
4645 else if (EQ (keyword
, QCbackground
))
4646 value
= LFACE_BACKGROUND (lface
);
4647 else if (EQ (keyword
, QCstipple
))
4648 value
= LFACE_STIPPLE (lface
);
4649 else if (EQ (keyword
, QCwidth
))
4650 value
= LFACE_SWIDTH (lface
);
4651 else if (EQ (keyword
, QCinherit
))
4652 value
= LFACE_INHERIT (lface
);
4653 else if (EQ (keyword
, QCfont
))
4654 value
= LFACE_FONT (lface
);
4656 signal_error ("Invalid face attribute name", keyword
);
4662 DEFUN ("internal-lisp-face-attribute-values",
4663 Finternal_lisp_face_attribute_values
,
4664 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4665 "Return a list of valid discrete values for face attribute ATTR.\n\
4666 Value is nil if ATTR doesn't have a discrete set of valid values.")
4670 Lisp_Object result
= Qnil
;
4672 CHECK_SYMBOL (attr
, 0);
4674 if (EQ (attr
, QCweight
)
4675 || EQ (attr
, QCslant
)
4676 || EQ (attr
, QCwidth
))
4678 /* Extract permissible symbols from tables. */
4679 struct table_entry
*table
;
4682 if (EQ (attr
, QCweight
))
4683 table
= weight_table
, dim
= DIM (weight_table
);
4684 else if (EQ (attr
, QCslant
))
4685 table
= slant_table
, dim
= DIM (slant_table
);
4687 table
= swidth_table
, dim
= DIM (swidth_table
);
4689 for (i
= 0; i
< dim
; ++i
)
4691 Lisp_Object symbol
= *table
[i
].symbol
;
4692 Lisp_Object tail
= result
;
4695 && !EQ (XCAR (tail
), symbol
))
4699 result
= Fcons (symbol
, result
);
4702 else if (EQ (attr
, QCunderline
))
4703 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4704 else if (EQ (attr
, QCoverline
))
4705 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4706 else if (EQ (attr
, QCstrike_through
))
4707 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4708 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4709 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4715 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4716 Sinternal_merge_in_global_face
, 2, 2, 0,
4717 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4718 Default face attributes override any local face attributes.")
4720 Lisp_Object face
, frame
;
4723 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4725 CHECK_LIVE_FRAME (frame
, 1);
4726 global_lface
= lface_from_face_name (NULL
, face
, 1);
4727 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4728 if (NILP (local_lface
))
4729 local_lface
= Finternal_make_lisp_face (face
, frame
);
4731 /* Make every specified global attribute override the local one.
4732 BEWARE!! This is only used from `face-set-after-frame-default' where
4733 the local frame is defined from default specs in `face-defface-spec'
4734 and those should be overridden by global settings. Hence the strange
4735 "global before local" priority. */
4736 lvec
= XVECTOR (local_lface
)->contents
;
4737 gvec
= XVECTOR (global_lface
)->contents
;
4738 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4739 if (! UNSPECIFIEDP (gvec
[i
]))
4746 /* The following function is implemented for compatibility with 20.2.
4747 The function is used in x-resolve-fonts when it is asked to
4748 return fonts with the same size as the font of a face. This is
4749 done in fontset.el. */
4751 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4752 "Return the font name of face FACE, or nil if it is unspecified.\n\
4753 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4754 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4755 The font default for a face is either nil, or a list\n\
4756 of the form (bold), (italic) or (bold italic).\n\
4757 If FRAME is omitted or nil, use the selected frame.")
4759 Lisp_Object face
, frame
;
4763 Lisp_Object result
= Qnil
;
4764 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4766 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4767 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4768 result
= Fcons (Qbold
, result
);
4770 if (!NILP (LFACE_SLANT (lface
))
4771 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4772 result
= Fcons (Qitalic
, result
);
4778 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4779 int face_id
= lookup_named_face (f
, face
, 0);
4780 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4781 return face
? build_string (face
->font_name
) : Qnil
;
4786 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4787 all attributes are `equal'. Tries to be fast because this function
4788 is called quite often. */
4791 lface_equal_p (v1
, v2
)
4792 Lisp_Object
*v1
, *v2
;
4796 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4798 Lisp_Object a
= v1
[i
];
4799 Lisp_Object b
= v2
[i
];
4801 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4802 and the other is specified. */
4803 equal_p
= XTYPE (a
) == XTYPE (b
);
4812 equal_p
= ((STRING_BYTES (XSTRING (a
))
4813 == STRING_BYTES (XSTRING (b
)))
4814 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4815 STRING_BYTES (XSTRING (a
))) == 0);
4824 equal_p
= !NILP (Fequal (a
, b
));
4834 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4835 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4836 "True if FACE1 and FACE2 are equal.\n\
4837 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4838 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4839 If FRAME is omitted or nil, use the selected frame.")
4840 (face1
, face2
, frame
)
4841 Lisp_Object face1
, face2
, frame
;
4845 Lisp_Object lface1
, lface2
;
4850 /* Don't use check_x_frame here because this function is called
4851 before X frames exist. At that time, if FRAME is nil,
4852 selected_frame will be used which is the frame dumped with
4853 Emacs. That frame is not an X frame. */
4854 f
= frame_or_selected_frame (frame
, 2);
4856 lface1
= lface_from_face_name (NULL
, face1
, 1);
4857 lface2
= lface_from_face_name (NULL
, face2
, 1);
4858 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4859 XVECTOR (lface2
)->contents
);
4860 return equal_p
? Qt
: Qnil
;
4864 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4865 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4866 "True if FACE has no attribute specified.\n\
4867 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4868 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4869 If FRAME is omitted or nil, use the selected frame.")
4871 Lisp_Object face
, frame
;
4878 frame
= selected_frame
;
4879 CHECK_LIVE_FRAME (frame
, 0);
4883 lface
= lface_from_face_name (NULL
, face
, 1);
4885 lface
= lface_from_face_name (f
, face
, 1);
4887 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4888 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4891 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4895 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4897 "Return an alist of frame-local faces defined on FRAME.\n\
4898 For internal use only.")
4902 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4903 return f
->face_alist
;
4907 /* Return a hash code for Lisp string STRING with case ignored. Used
4908 below in computing a hash value for a Lisp face. */
4910 static INLINE
unsigned
4911 hash_string_case_insensitive (string
)
4916 xassert (STRINGP (string
));
4917 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4918 hash
= (hash
<< 1) ^ tolower (*s
);
4923 /* Return a hash code for face attribute vector V. */
4925 static INLINE
unsigned
4929 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4930 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4931 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4932 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4933 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4934 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4935 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4939 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4940 considering charsets/registries). They do if they specify the same
4941 family, point size, weight, width, slant, and fontset. Both LFACE1
4942 and LFACE2 must be fully-specified. */
4945 lface_same_font_attributes_p (lface1
, lface2
)
4946 Lisp_Object
*lface1
, *lface2
;
4948 xassert (lface_fully_specified_p (lface1
)
4949 && lface_fully_specified_p (lface2
));
4950 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4951 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4952 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4953 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4954 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4955 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4956 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4957 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4958 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4959 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4960 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4965 /***********************************************************************
4967 ***********************************************************************/
4969 /* Allocate and return a new realized face for Lisp face attribute
4972 static struct face
*
4973 make_realized_face (attr
)
4976 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4977 bzero (face
, sizeof *face
);
4978 face
->ascii_face
= face
;
4979 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4984 /* Free realized face FACE, including its X resources. FACE may
4988 free_realized_face (f
, face
)
4994 #ifdef HAVE_WINDOW_SYSTEM
4995 if (FRAME_WINDOW_P (f
))
4997 /* Free fontset of FACE if it is ASCII face. */
4998 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4999 free_face_fontset (f
, face
);
5002 x_free_gc (f
, face
->gc
);
5006 free_face_colors (f
, face
);
5007 x_destroy_bitmap (f
, face
->stipple
);
5009 #endif /* HAVE_WINDOW_SYSTEM */
5016 /* Prepare face FACE for subsequent display on frame F. This
5017 allocated GCs if they haven't been allocated yet or have been freed
5018 by clearing the face cache. */
5021 prepare_face_for_display (f
, face
)
5025 #ifdef HAVE_WINDOW_SYSTEM
5026 xassert (FRAME_WINDOW_P (f
));
5031 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5033 xgcv
.foreground
= face
->foreground
;
5034 xgcv
.background
= face
->background
;
5035 #ifdef HAVE_X_WINDOWS
5036 xgcv
.graphics_exposures
= False
;
5038 /* The font of FACE may be null if we couldn't load it. */
5041 #ifdef HAVE_X_WINDOWS
5042 xgcv
.font
= face
->font
->fid
;
5045 xgcv
.font
= face
->font
;
5048 xgcv
.font
= face
->font
;
5054 #ifdef HAVE_X_WINDOWS
5057 xgcv
.fill_style
= FillOpaqueStippled
;
5058 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5059 mask
|= GCFillStyle
| GCStipple
;
5062 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5065 #endif /* HAVE_WINDOW_SYSTEM */
5069 /***********************************************************************
5071 ***********************************************************************/
5073 /* Return a new face cache for frame F. */
5075 static struct face_cache
*
5079 struct face_cache
*c
;
5082 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5083 bzero (c
, sizeof *c
);
5084 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5085 c
->buckets
= (struct face
**) xmalloc (size
);
5086 bzero (c
->buckets
, size
);
5088 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5094 /* Clear out all graphics contexts for all realized faces, except for
5095 the basic faces. This should be done from time to time just to avoid
5096 keeping too many graphics contexts that are no longer needed. */
5100 struct face_cache
*c
;
5102 if (c
&& FRAME_WINDOW_P (c
->f
))
5104 #ifdef HAVE_WINDOW_SYSTEM
5106 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5108 struct face
*face
= c
->faces_by_id
[i
];
5109 if (face
&& face
->gc
)
5111 x_free_gc (c
->f
, face
->gc
);
5115 #endif /* HAVE_WINDOW_SYSTEM */
5120 /* Free all realized faces in face cache C, including basic faces. C
5121 may be null. If faces are freed, make sure the frame's current
5122 matrix is marked invalid, so that a display caused by an expose
5123 event doesn't try to use faces we destroyed. */
5126 free_realized_faces (c
)
5127 struct face_cache
*c
;
5132 struct frame
*f
= c
->f
;
5134 /* We must block input here because we can't process X events
5135 safely while only some faces are freed, or when the frame's
5136 current matrix still references freed faces. */
5139 for (i
= 0; i
< c
->used
; ++i
)
5141 free_realized_face (f
, c
->faces_by_id
[i
]);
5142 c
->faces_by_id
[i
] = NULL
;
5146 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5147 bzero (c
->buckets
, size
);
5149 /* Must do a thorough redisplay the next time. Mark current
5150 matrices as invalid because they will reference faces freed
5151 above. This function is also called when a frame is
5152 destroyed. In this case, the root window of F is nil. */
5153 if (WINDOWP (f
->root_window
))
5155 clear_current_matrices (f
);
5156 ++windows_or_buffers_changed
;
5164 /* Free all faces realized for multibyte characters on frame F that
5168 free_realized_multibyte_face (f
, fontset
)
5172 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5176 /* We must block input here because we can't process X events safely
5177 while only some faces are freed, or when the frame's current
5178 matrix still references freed faces. */
5181 for (i
= 0; i
< cache
->used
; i
++)
5183 face
= cache
->faces_by_id
[i
];
5185 && face
!= face
->ascii_face
5186 && face
->fontset
== fontset
)
5188 uncache_face (cache
, face
);
5189 free_realized_face (f
, face
);
5193 /* Must do a thorough redisplay the next time. Mark current
5194 matrices as invalid because they will reference faces freed
5195 above. This function is also called when a frame is destroyed.
5196 In this case, the root window of F is nil. */
5197 if (WINDOWP (f
->root_window
))
5199 clear_current_matrices (f
);
5200 ++windows_or_buffers_changed
;
5207 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5208 This is done after attributes of a named face have been changed,
5209 because we can't tell which realized faces depend on that face. */
5212 free_all_realized_faces (frame
)
5218 FOR_EACH_FRAME (rest
, frame
)
5219 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5222 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5226 /* Free face cache C and faces in it, including their X resources. */
5230 struct face_cache
*c
;
5234 free_realized_faces (c
);
5236 xfree (c
->faces_by_id
);
5242 /* Cache realized face FACE in face cache C. HASH is the hash value
5243 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5244 collision list of the face hash table of C. This is done because
5245 otherwise lookup_face would find FACE for every character, even if
5246 faces with the same attributes but for specific characters exist. */
5249 cache_face (c
, face
, hash
)
5250 struct face_cache
*c
;
5254 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5258 if (face
->fontset
>= 0)
5260 struct face
*last
= c
->buckets
[i
];
5271 c
->buckets
[i
] = face
;
5272 face
->prev
= face
->next
= NULL
;
5278 face
->next
= c
->buckets
[i
];
5280 face
->next
->prev
= face
;
5281 c
->buckets
[i
] = face
;
5284 /* Find a free slot in C->faces_by_id and use the index of the free
5285 slot as FACE->id. */
5286 for (i
= 0; i
< c
->used
; ++i
)
5287 if (c
->faces_by_id
[i
] == NULL
)
5291 /* Maybe enlarge C->faces_by_id. */
5292 if (i
== c
->used
&& c
->used
== c
->size
)
5294 int new_size
= 2 * c
->size
;
5295 int sz
= new_size
* sizeof *c
->faces_by_id
;
5296 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5301 /* Check that FACE got a unique id. */
5306 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5307 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5313 #endif /* GLYPH_DEBUG */
5315 c
->faces_by_id
[i
] = face
;
5321 /* Remove face FACE from cache C. */
5324 uncache_face (c
, face
)
5325 struct face_cache
*c
;
5328 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5331 face
->prev
->next
= face
->next
;
5333 c
->buckets
[i
] = face
->next
;
5336 face
->next
->prev
= face
->prev
;
5338 c
->faces_by_id
[face
->id
] = NULL
;
5339 if (face
->id
== c
->used
)
5344 /* Look up a realized face with face attributes ATTR in the face cache
5345 of frame F. The face will be used to display character C. Value
5346 is the ID of the face found. If no suitable face is found, realize
5347 a new one. In that case, if C is a multibyte character, BASE_FACE
5348 is a face that has the same attributes. */
5351 lookup_face (f
, attr
, c
, base_face
)
5355 struct face
*base_face
;
5357 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5362 xassert (cache
!= NULL
);
5363 check_lface_attrs (attr
);
5365 /* Look up ATTR in the face cache. */
5366 hash
= lface_hash (attr
);
5367 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5369 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5370 if (face
->hash
== hash
5371 && (!FRAME_WINDOW_P (f
)
5372 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5373 && lface_equal_p (face
->lface
, attr
))
5376 /* If not found, realize a new face. */
5378 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5381 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5383 /* When this function is called from face_for_char (in this case, C is
5384 a multibyte character), a fontset of a face returned by
5385 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5386 C) is not sutisfied. The fontset is set for this face by
5387 face_for_char later. */
5389 if (FRAME_WINDOW_P (f
))
5390 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5392 #endif /* GLYPH_DEBUG */
5398 /* Return the face id of the realized face for named face SYMBOL on
5399 frame F suitable for displaying character C. Value is -1 if the
5400 face couldn't be determined, which might happen if the default face
5401 isn't realized and cannot be realized. */
5404 lookup_named_face (f
, symbol
, c
)
5409 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5410 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5411 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5413 if (default_face
== NULL
)
5415 if (!realize_basic_faces (f
))
5417 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5420 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5421 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5422 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5423 return lookup_face (f
, attrs
, c
, NULL
);
5427 /* Return the ID of the realized ASCII face of Lisp face with ID
5428 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5431 ascii_face_of_lisp_face (f
, lface_id
)
5437 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5439 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5440 face_id
= lookup_named_face (f
, face_name
, 0);
5449 /* Return a face for charset ASCII that is like the face with id
5450 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5451 STEPS < 0 means larger. Value is the id of the face. */
5454 smaller_face (f
, face_id
, steps
)
5458 #ifdef HAVE_WINDOW_SYSTEM
5460 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5461 int pt
, last_pt
, last_height
;
5464 struct face
*new_face
;
5466 /* If not called for an X frame, just return the original face. */
5467 if (FRAME_TERMCAP_P (f
))
5470 /* Try in increments of 1/2 pt. */
5471 delta
= steps
< 0 ? 5 : -5;
5472 steps
= abs (steps
);
5474 face
= FACE_FROM_ID (f
, face_id
);
5475 bcopy (face
->lface
, attrs
, sizeof attrs
);
5476 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5477 new_face_id
= face_id
;
5478 last_height
= FONT_HEIGHT (face
->font
);
5482 /* Give up if we cannot find a font within 10pt. */
5483 && abs (last_pt
- pt
) < 100)
5485 /* Look up a face for a slightly smaller/larger font. */
5487 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5488 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5489 new_face
= FACE_FROM_ID (f
, new_face_id
);
5491 /* If height changes, count that as one step. */
5492 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5493 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5496 last_height
= FONT_HEIGHT (new_face
->font
);
5503 #else /* not HAVE_WINDOW_SYSTEM */
5507 #endif /* not HAVE_WINDOW_SYSTEM */
5511 /* Return a face for charset ASCII that is like the face with id
5512 FACE_ID on frame F, but has height HEIGHT. */
5515 face_with_height (f
, face_id
, height
)
5520 #ifdef HAVE_WINDOW_SYSTEM
5522 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5524 if (FRAME_TERMCAP_P (f
)
5528 face
= FACE_FROM_ID (f
, face_id
);
5529 bcopy (face
->lface
, attrs
, sizeof attrs
);
5530 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5531 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5532 #endif /* HAVE_WINDOW_SYSTEM */
5538 /* Return the face id of the realized face for named face SYMBOL on
5539 frame F suitable for displaying character C, and use attributes of
5540 the face FACE_ID for attributes that aren't completely specified by
5541 SYMBOL. This is like lookup_named_face, except that the default
5542 attributes come from FACE_ID, not from the default face. FACE_ID
5543 is assumed to be already realized. */
5546 lookup_derived_face (f
, symbol
, c
, face_id
)
5552 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5553 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5554 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5559 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5560 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5561 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5562 return lookup_face (f
, attrs
, c
, default_face
);
5567 /***********************************************************************
5569 ***********************************************************************/
5571 DEFUN ("internal-set-font-selection-order",
5572 Finternal_set_font_selection_order
,
5573 Sinternal_set_font_selection_order
, 1, 1, 0,
5574 "Set font selection order for face font selection to ORDER.\n\
5575 ORDER must be a list of length 4 containing the symbols `:width',\n\
5576 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5577 first in ORDER are matched first, e.g. if `:height' appears before\n\
5578 `:weight' in ORDER, font selection first tries to find a font with\n\
5579 a suitable height, and then tries to match the font weight.\n\
5588 CHECK_LIST (order
, 0);
5589 bzero (indices
, sizeof indices
);
5593 CONSP (list
) && i
< DIM (indices
);
5594 list
= XCDR (list
), ++i
)
5596 Lisp_Object attr
= XCAR (list
);
5599 if (EQ (attr
, QCwidth
))
5601 else if (EQ (attr
, QCheight
))
5602 xlfd
= XLFD_POINT_SIZE
;
5603 else if (EQ (attr
, QCweight
))
5605 else if (EQ (attr
, QCslant
))
5610 if (indices
[i
] != 0)
5616 || i
!= DIM (indices
)
5621 signal_error ("Invalid font sort order", order
);
5623 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5625 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5626 free_all_realized_faces (Qnil
);
5633 DEFUN ("internal-set-alternative-font-family-alist",
5634 Finternal_set_alternative_font_family_alist
,
5635 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5636 "Define alternative font families to try in face font selection.\n\
5637 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5638 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5639 be found. Value is ALIST.")
5643 CHECK_LIST (alist
, 0);
5644 Vface_alternative_font_family_alist
= alist
;
5645 free_all_realized_faces (Qnil
);
5650 DEFUN ("internal-set-alternative-font-registry-alist",
5651 Finternal_set_alternative_font_registry_alist
,
5652 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5653 "Define alternative font registries to try in face font selection.\n\
5654 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5655 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5656 be found. Value is ALIST.")
5660 CHECK_LIST (alist
, 0);
5661 Vface_alternative_font_registry_alist
= alist
;
5662 free_all_realized_faces (Qnil
);
5667 #ifdef HAVE_WINDOW_SYSTEM
5669 /* Value is non-zero if FONT is the name of a scalable font. The
5670 X11R6 XLFD spec says that point size, pixel size, and average width
5671 are zero for scalable fonts. Intlfonts contain at least one
5672 scalable font ("*-muleindian-1") for which this isn't true, so we
5673 just test average width. */
5676 font_scalable_p (font
)
5677 struct font_name
*font
;
5679 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5680 return (*s
== '0' && *(s
+ 1) == '\0')
5682 /* Windows implementation of XLFD is slightly broken for backward
5683 compatibility with previous broken versions, so test for
5684 wildcards as well as 0. */
5691 /* Ignore the difference of font point size less than this value. */
5693 #define FONT_POINT_SIZE_QUANTUM 5
5695 /* Value is non-zero if FONT1 is a better match for font attributes
5696 VALUES than FONT2. VALUES is an array of face attribute values in
5697 font sort order. COMPARE_PT_P zero means don't compare point
5701 better_font_p (values
, font1
, font2
, compare_pt_p
)
5703 struct font_name
*font1
, *font2
;
5708 for (i
= 0; i
< 4; ++i
)
5710 int xlfd_idx
= font_sort_order
[i
];
5712 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5714 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5715 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5717 if (xlfd_idx
== XLFD_POINT_SIZE
5718 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5720 if (delta1
> delta2
)
5722 else if (delta1
< delta2
)
5726 /* The difference may be equal because, e.g., the face
5727 specifies `italic' but we have only `regular' and
5728 `oblique'. Prefer `oblique' in this case. */
5729 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5730 && font1
->numeric
[xlfd_idx
] > values
[i
]
5731 && font2
->numeric
[xlfd_idx
] < values
[i
])
5737 return (font1
->registry_priority
< font2
->registry_priority
);
5741 /* Value is non-zero if FONT is an exact match for face attributes in
5742 SPECIFIED. SPECIFIED is an array of face attribute values in font
5746 exact_face_match_p (specified
, font
)
5748 struct font_name
*font
;
5752 for (i
= 0; i
< 4; ++i
)
5753 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5760 /* Value is the name of a scaled font, generated from scalable font
5761 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5762 Value is allocated from heap. */
5765 build_scalable_font_name (f
, font
, specified_pt
)
5767 struct font_name
*font
;
5770 char point_size
[20], pixel_size
[20];
5772 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5775 /* If scalable font is for a specific resolution, compute
5776 the point size we must specify from the resolution of
5777 the display and the specified resolution of the font. */
5778 if (font
->numeric
[XLFD_RESY
] != 0)
5780 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5781 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5786 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5789 /* Set point size of the font. */
5790 sprintf (point_size
, "%d", (int) pt
);
5791 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5792 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5794 /* Set pixel size. */
5795 sprintf (pixel_size
, "%d", pixel_value
);
5796 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5797 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5799 /* If font doesn't specify its resolution, use the
5800 resolution of the display. */
5801 if (font
->numeric
[XLFD_RESY
] == 0)
5804 sprintf (buffer
, "%d", (int) resy
);
5805 font
->fields
[XLFD_RESY
] = buffer
;
5806 font
->numeric
[XLFD_RESY
] = resy
;
5809 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5812 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5813 sprintf (buffer
, "%d", resx
);
5814 font
->fields
[XLFD_RESX
] = buffer
;
5815 font
->numeric
[XLFD_RESX
] = resx
;
5818 return build_font_name (font
);
5822 /* Value is non-zero if we are allowed to use scalable font FONT. We
5823 can't run a Lisp function here since this function may be called
5824 with input blocked. */
5827 may_use_scalable_font_p (font
, name
)
5828 struct font_name
*font
;
5831 if (EQ (Vscalable_fonts_allowed
, Qt
))
5833 else if (CONSP (Vscalable_fonts_allowed
))
5835 Lisp_Object tail
, regexp
;
5837 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5839 regexp
= XCAR (tail
);
5840 if (STRINGP (regexp
)
5841 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5851 /* Return the name of the best matching font for face attributes
5852 ATTRS in the array of font_name structures FONTS which contains
5853 NFONTS elements. Value is a font name which is allocated from
5854 the heap. FONTS is freed by this function. */
5857 best_matching_font (f
, attrs
, fonts
, nfonts
)
5860 struct font_name
*fonts
;
5864 struct font_name
*best
;
5872 /* Make specified font attributes available in `specified',
5873 indexed by sort order. */
5874 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5876 int xlfd_idx
= font_sort_order
[i
];
5878 if (xlfd_idx
== XLFD_SWIDTH
)
5879 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5880 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5881 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5882 else if (xlfd_idx
== XLFD_WEIGHT
)
5883 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5884 else if (xlfd_idx
== XLFD_SLANT
)
5885 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5892 /* Start with the first non-scalable font in the list. */
5893 for (i
= 0; i
< nfonts
; ++i
)
5894 if (!font_scalable_p (fonts
+ i
))
5897 /* Find the best match among the non-scalable fonts. */
5902 for (i
= 1; i
< nfonts
; ++i
)
5903 if (!font_scalable_p (fonts
+ i
)
5904 && better_font_p (specified
, fonts
+ i
, best
, 1))
5908 exact_p
= exact_face_match_p (specified
, best
);
5917 /* Unless we found an exact match among non-scalable fonts, see if
5918 we can find a better match among scalable fonts. */
5921 /* A scalable font is better if
5923 1. its weight, slant, swidth attributes are better, or.
5925 2. the best non-scalable font doesn't have the required
5926 point size, and the scalable fonts weight, slant, swidth
5929 int non_scalable_has_exact_height_p
;
5931 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5932 non_scalable_has_exact_height_p
= 1;
5934 non_scalable_has_exact_height_p
= 0;
5936 for (i
= 0; i
< nfonts
; ++i
)
5937 if (font_scalable_p (fonts
+ i
))
5940 || better_font_p (specified
, fonts
+ i
, best
, 0)
5941 || (!non_scalable_has_exact_height_p
5942 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5947 if (font_scalable_p (best
))
5948 font_name
= build_scalable_font_name (f
, best
, pt
);
5950 font_name
= build_font_name (best
);
5952 /* Free font_name structures. */
5953 free_font_names (fonts
, nfonts
);
5959 /* Try to get a list of fonts on frame F with font family FAMILY and
5960 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5961 of font_name structures for the fonts matched. Value is the number
5965 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5968 Lisp_Object pattern
, family
, registry
;
5969 struct font_name
**fonts
;
5973 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5974 family
= attrs
[LFACE_FAMILY_INDEX
];
5976 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5977 if (nfonts
== 0 && !NILP (family
))
5981 /* Try alternative font families. */
5982 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5984 for (alter
= XCDR (alter
);
5985 CONSP (alter
) && nfonts
== 0;
5986 alter
= XCDR (alter
))
5988 if (STRINGP (XCAR (alter
)))
5989 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5992 /* Try font family of the default face or "fixed". */
5995 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5997 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5999 family
= build_string ("fixed");
6000 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6003 /* Try any family with the given registry. */
6005 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6012 /* Return the fontset id of the base fontset name or alias name given
6013 by the fontset attribute of ATTRS. Value is -1 if the fontset
6014 attribute of ATTRS doesn't name a fontset. */
6017 face_fontset (attrs
)
6023 name
= attrs
[LFACE_FONT_INDEX
];
6024 if (!STRINGP (name
))
6026 return fs_query_fontset (name
, 0);
6030 /* Choose a name of font to use on frame F to display character C with
6031 Lisp face attributes specified by ATTRS. The font name is
6032 determined by the font-related attributes in ATTRS and the name
6033 pattern for C in FONTSET. Value is the font name which is
6034 allocated from the heap and must be freed by the caller, or NULL if
6035 we can get no information about the font name of C. It is assured
6036 that we always get some information for a single byte
6040 choose_face_font (f
, attrs
, fontset
, c
)
6045 Lisp_Object pattern
;
6046 char *font_name
= NULL
;
6047 struct font_name
*fonts
;
6050 /* Get (foundry and) family name and registry (and encoding) name of
6052 pattern
= fontset_font_pattern (f
, fontset
, c
);
6055 xassert (!SINGLE_BYTE_CHAR_P (c
));
6058 /* If what we got is a name pattern, return it. */
6059 if (STRINGP (pattern
))
6060 return xstrdup (XSTRING (pattern
)->data
);
6062 /* Family name may be specified both in ATTRS and car part of
6063 PATTERN. The former has higher priority if C is a single byte
6065 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
6066 && SINGLE_BYTE_CHAR_P (c
))
6067 XCAR (pattern
) = Qnil
;
6069 /* Get a list of fonts matching that pattern and choose the
6070 best match for the specified face attributes from it. */
6071 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
6073 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
6077 #endif /* HAVE_WINDOW_SYSTEM */
6081 /***********************************************************************
6083 ***********************************************************************/
6085 /* Realize basic faces on frame F. Value is zero if frame parameters
6086 of F don't contain enough information needed to realize the default
6090 realize_basic_faces (f
)
6095 /* Block input there so that we won't be surprised by an X expose
6096 event, for instance without having the faces set up. */
6099 if (realize_default_face (f
))
6101 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6102 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6103 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6104 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6105 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6106 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6107 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6108 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6109 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6111 /* Reflect changes in the `menu' face in menu bars. */
6112 if (menu_face_change_count
)
6114 menu_face_change_count
= 0;
6116 #ifdef USE_X_TOOLKIT
6119 Widget menu
= f
->output_data
.x
->menubar_widget
;
6121 x_set_menu_resources_from_menu_face (f
, menu
);
6123 #endif /* USE_X_TOOLKIT */
6134 /* Realize the default face on frame F. If the face is not fully
6135 specified, make it fully-specified. Attributes of the default face
6136 that are not explicitly specified are taken from frame parameters. */
6139 realize_default_face (f
)
6142 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6144 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6145 Lisp_Object frame_font
;
6149 /* If the `default' face is not yet known, create it. */
6150 lface
= lface_from_face_name (f
, Qdefault
, 0);
6154 XSETFRAME (frame
, f
);
6155 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6158 #ifdef HAVE_WINDOW_SYSTEM
6159 if (FRAME_WINDOW_P (f
))
6161 /* Set frame_font to the value of the `font' frame parameter. */
6162 frame_font
= Fassq (Qfont
, f
->param_alist
);
6163 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6164 frame_font
= XCDR (frame_font
);
6165 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6167 #endif /* HAVE_WINDOW_SYSTEM */
6169 if (!FRAME_WINDOW_P (f
))
6171 LFACE_FAMILY (lface
) = build_string ("default");
6172 LFACE_SWIDTH (lface
) = Qnormal
;
6173 LFACE_HEIGHT (lface
) = make_number (1);
6174 LFACE_WEIGHT (lface
) = Qnormal
;
6175 LFACE_SLANT (lface
) = Qnormal
;
6178 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6179 LFACE_UNDERLINE (lface
) = Qnil
;
6181 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6182 LFACE_OVERLINE (lface
) = Qnil
;
6184 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6185 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6187 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6188 LFACE_BOX (lface
) = Qnil
;
6190 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6191 LFACE_INVERSE (lface
) = Qnil
;
6193 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6195 /* This function is called so early that colors are not yet
6196 set in the frame parameter list. */
6197 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6199 if (CONSP (color
) && STRINGP (XCDR (color
)))
6200 LFACE_FOREGROUND (lface
) = XCDR (color
);
6201 else if (FRAME_WINDOW_P (f
))
6203 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6204 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6209 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6211 /* This function is called so early that colors are not yet
6212 set in the frame parameter list. */
6213 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6214 if (CONSP (color
) && STRINGP (XCDR (color
)))
6215 LFACE_BACKGROUND (lface
) = XCDR (color
);
6216 else if (FRAME_WINDOW_P (f
))
6218 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6219 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6224 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6225 LFACE_STIPPLE (lface
) = Qnil
;
6227 /* Realize the face; it must be fully-specified now. */
6228 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6229 check_lface (lface
);
6230 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6231 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6236 /* Realize basic faces other than the default face in face cache C.
6237 SYMBOL is the face name, ID is the face id the realized face must
6238 have. The default face must have been realized already. */
6241 realize_named_face (f
, symbol
, id
)
6246 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6247 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6248 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6249 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6250 struct face
*new_face
;
6252 /* The default face must exist and be fully specified. */
6253 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6254 check_lface_attrs (attrs
);
6255 xassert (lface_fully_specified_p (attrs
));
6257 /* If SYMBOL isn't know as a face, create it. */
6261 XSETFRAME (frame
, f
);
6262 lface
= Finternal_make_lisp_face (symbol
, frame
);
6265 /* Merge SYMBOL's face with the default face. */
6266 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6267 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6269 /* Realize the face. */
6270 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6274 /* Realize the fully-specified face with attributes ATTRS in face
6275 cache CACHE for character C. If C is a multibyte character,
6276 BASE_FACE is a face that has the same attributes. Otherwise,
6277 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6278 ID of face to remove before caching the new face. Value is a
6279 pointer to the newly created realized face. */
6281 static struct face
*
6282 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6283 struct face_cache
*cache
;
6286 struct face
*base_face
;
6291 /* LFACE must be fully specified. */
6292 xassert (cache
!= NULL
);
6293 check_lface_attrs (attrs
);
6295 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6297 /* Remove the former face. */
6298 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6299 uncache_face (cache
, former_face
);
6300 free_realized_face (cache
->f
, former_face
);
6303 if (FRAME_WINDOW_P (cache
->f
))
6304 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6305 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6306 face
= realize_tty_face (cache
, attrs
, c
);
6310 /* Insert the new face. */
6311 cache_face (cache
, face
, lface_hash (attrs
));
6312 #ifdef HAVE_WINDOW_SYSTEM
6313 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6314 load_face_font (cache
->f
, face
, c
);
6315 #endif /* HAVE_WINDOW_SYSTEM */
6320 /* Realize the fully-specified face with attributes ATTRS in face
6321 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6322 a multibyte character, BASE_FACE is a face that has the same
6323 attributes. Otherwise, BASE_FACE is ignored. If the new face
6324 doesn't share font with the default face, a fontname is allocated
6325 from the heap and set in `font_name' of the new face, but it is not
6326 yet loaded here. Value is a pointer to the newly created realized
6329 static struct face
*
6330 realize_x_face (cache
, attrs
, c
, base_face
)
6331 struct face_cache
*cache
;
6334 struct face
*base_face
;
6336 #ifdef HAVE_WINDOW_SYSTEM
6337 struct face
*face
, *default_face
;
6339 Lisp_Object stipple
, overline
, strike_through
, box
;
6341 xassert (FRAME_WINDOW_P (cache
->f
));
6342 xassert (SINGLE_BYTE_CHAR_P (c
)
6345 /* Allocate a new realized face. */
6346 face
= make_realized_face (attrs
);
6350 /* If C is a multibyte character, we share all face attirbutes with
6351 BASE_FACE including the realized fontset. But, we must load a
6353 if (!SINGLE_BYTE_CHAR_P (c
))
6355 bcopy (base_face
, face
, sizeof *face
);
6358 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6359 face
->foreground_defaulted_p
= 1;
6360 face
->background_defaulted_p
= 1;
6361 face
->underline_defaulted_p
= 1;
6362 face
->overline_color_defaulted_p
= 1;
6363 face
->strike_through_color_defaulted_p
= 1;
6364 face
->box_color_defaulted_p
= 1;
6366 /* to force realize_face to load font */
6371 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6373 /* Determine the font to use. Most of the time, the font will be
6374 the same as the font of the default face, so try that first. */
6375 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6377 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6378 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6380 face
->font
= default_face
->font
;
6381 face
->fontset
= default_face
->fontset
;
6382 face
->font_info_id
= default_face
->font_info_id
;
6383 face
->font_name
= default_face
->font_name
;
6384 face
->ascii_face
= face
;
6386 /* But, as we can't share the fontset, make a new realized
6387 fontset that has the same base fontset as of the default
6390 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6394 /* If the face attribute ATTRS specifies a fontset, use it as
6395 the base of a new realized fontset. Otherwise, use the same
6396 base fontset as of the default face. The base determines
6397 registry and encoding of a font. It may also determine
6398 foundry and family. The other fields of font name pattern
6399 are constructed from ATTRS. */
6400 int fontset
= face_fontset (attrs
);
6402 if ((fontset
== -1) && default_face
)
6403 fontset
= default_face
->fontset
;
6404 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6405 face
->font
= NULL
; /* to force realize_face to load font */
6408 /* Load the font if it is specified in ATTRS. This fixes
6409 changing frame font on the Mac. */
6410 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6412 struct font_info
*font_info
=
6413 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6415 face
->font
= font_info
->font
;
6420 /* Load colors, and set remaining attributes. */
6422 load_face_colors (f
, face
, attrs
);
6425 box
= attrs
[LFACE_BOX_INDEX
];
6428 /* A simple box of line width 1 drawn in color given by
6430 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6432 face
->box
= FACE_SIMPLE_BOX
;
6433 face
->box_line_width
= 1;
6435 else if (INTEGERP (box
))
6437 /* Simple box of specified line width in foreground color of the
6439 xassert (XINT (box
) > 0);
6440 face
->box
= FACE_SIMPLE_BOX
;
6441 face
->box_line_width
= XFASTINT (box
);
6442 face
->box_color
= face
->foreground
;
6443 face
->box_color_defaulted_p
= 1;
6445 else if (CONSP (box
))
6447 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6448 being one of `raised' or `sunken'. */
6449 face
->box
= FACE_SIMPLE_BOX
;
6450 face
->box_color
= face
->foreground
;
6451 face
->box_color_defaulted_p
= 1;
6452 face
->box_line_width
= 1;
6456 Lisp_Object keyword
, value
;
6458 keyword
= XCAR (box
);
6466 if (EQ (keyword
, QCline_width
))
6468 if (INTEGERP (value
) && XINT (value
) > 0)
6469 face
->box_line_width
= XFASTINT (value
);
6471 else if (EQ (keyword
, QCcolor
))
6473 if (STRINGP (value
))
6475 face
->box_color
= load_color (f
, face
, value
,
6477 face
->use_box_color_for_shadows_p
= 1;
6480 else if (EQ (keyword
, QCstyle
))
6482 if (EQ (value
, Qreleased_button
))
6483 face
->box
= FACE_RAISED_BOX
;
6484 else if (EQ (value
, Qpressed_button
))
6485 face
->box
= FACE_SUNKEN_BOX
;
6490 /* Text underline, overline, strike-through. */
6492 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6494 /* Use default color (same as foreground color). */
6495 face
->underline_p
= 1;
6496 face
->underline_defaulted_p
= 1;
6497 face
->underline_color
= 0;
6499 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6501 /* Use specified color. */
6502 face
->underline_p
= 1;
6503 face
->underline_defaulted_p
= 0;
6504 face
->underline_color
6505 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6506 LFACE_UNDERLINE_INDEX
);
6508 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6510 face
->underline_p
= 0;
6511 face
->underline_defaulted_p
= 0;
6512 face
->underline_color
= 0;
6515 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6516 if (STRINGP (overline
))
6518 face
->overline_color
6519 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6520 LFACE_OVERLINE_INDEX
);
6521 face
->overline_p
= 1;
6523 else if (EQ (overline
, Qt
))
6525 face
->overline_color
= face
->foreground
;
6526 face
->overline_color_defaulted_p
= 1;
6527 face
->overline_p
= 1;
6530 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6531 if (STRINGP (strike_through
))
6533 face
->strike_through_color
6534 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6535 LFACE_STRIKE_THROUGH_INDEX
);
6536 face
->strike_through_p
= 1;
6538 else if (EQ (strike_through
, Qt
))
6540 face
->strike_through_color
= face
->foreground
;
6541 face
->strike_through_color_defaulted_p
= 1;
6542 face
->strike_through_p
= 1;
6545 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6546 if (!NILP (stipple
))
6547 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6549 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6551 #endif /* HAVE_WINDOW_SYSTEM */
6555 /* Map a specified color of face FACE on frame F to a tty color index.
6556 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6557 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6558 default foreground/background colors. */
6561 map_tty_color (f
, face
, idx
, defaulted
)
6564 enum lface_attribute_index idx
;
6567 Lisp_Object frame
, color
, def
;
6568 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6569 unsigned long default_pixel
, default_other_pixel
, pixel
;
6571 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6575 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6576 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6580 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6581 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6584 XSETFRAME (frame
, f
);
6585 color
= face
->lface
[idx
];
6588 && XSTRING (color
)->size
6589 && CONSP (Vtty_defined_color_alist
)
6590 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6593 /* Associations in tty-defined-color-alist are of the form
6594 (NAME INDEX R G B). We need the INDEX part. */
6595 pixel
= XINT (XCAR (XCDR (def
)));
6598 if (pixel
== default_pixel
&& STRINGP (color
))
6600 pixel
= load_color (f
, face
, color
, idx
);
6602 #if defined (MSDOS) || defined (WINDOWSNT)
6603 /* If the foreground of the default face is the default color,
6604 use the foreground color defined by the frame. */
6606 if (FRAME_MSDOS_P (f
))
6609 if (pixel
== default_pixel
6610 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6613 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6615 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6616 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6619 else if (pixel
== default_other_pixel
)
6622 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6624 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6625 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6631 #endif /* MSDOS or WINDOWSNT */
6635 face
->foreground
= pixel
;
6637 face
->background
= pixel
;
6641 /* Realize the fully-specified face with attributes ATTRS in face
6642 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6643 pointer to the newly created realized face. */
6645 static struct face
*
6646 realize_tty_face (cache
, attrs
, c
)
6647 struct face_cache
*cache
;
6653 int face_colors_defaulted
= 0;
6654 struct frame
*f
= cache
->f
;
6656 /* Frame must be a termcap frame. */
6657 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6659 /* Allocate a new realized face. */
6660 face
= make_realized_face (attrs
);
6661 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6663 /* Map face attributes to TTY appearances. We map slant to
6664 dimmed text because we want italic text to appear differently
6665 and because dimmed text is probably used infrequently. */
6666 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6667 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6669 if (weight
> XLFD_WEIGHT_MEDIUM
)
6670 face
->tty_bold_p
= 1;
6671 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6672 face
->tty_dim_p
= 1;
6673 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6674 face
->tty_underline_p
= 1;
6675 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6676 face
->tty_reverse_p
= 1;
6678 /* Map color names to color indices. */
6679 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6680 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6682 /* Swap colors if face is inverse-video. If the colors are taken
6683 from the frame colors, they are already inverted, since the
6684 frame-creation function calls x-handle-reverse-video. */
6685 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6687 unsigned long tem
= face
->foreground
;
6688 face
->foreground
= face
->background
;
6689 face
->background
= tem
;
6692 if (tty_suppress_bold_inverse_default_colors_p
6694 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6695 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6696 face
->tty_bold_p
= 0;
6702 DEFUN ("tty-suppress-bold-inverse-default-colors",
6703 Ftty_suppress_bold_inverse_default_colors
,
6704 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6705 "Suppress/allow boldness of faces with inverse default colors.\n\
6706 SUPPRESS non-nil means suppress it.\n\
6707 This affects bold faces on TTYs whose foreground is the default background\n\
6708 color of the display and whose background is the default foreground color.\n\
6709 For such faces, the bold face attribute is ignored if this variable\n\
6712 Lisp_Object suppress
;
6714 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6715 ++face_change_count
;
6721 /***********************************************************************
6723 ***********************************************************************/
6725 /* Return the ID of the face to use to display character CH with face
6726 property PROP on frame F in current_buffer. */
6729 compute_char_face (f
, ch
, prop
)
6736 if (NILP (current_buffer
->enable_multibyte_characters
))
6741 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6742 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6746 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6747 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6748 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6749 merge_face_vector_with_property (f
, attrs
, prop
);
6750 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6757 /* Return the face ID associated with buffer position POS for
6758 displaying ASCII characters. Return in *ENDPTR the position at
6759 which a different face is needed, as far as text properties and
6760 overlays are concerned. W is a window displaying current_buffer.
6762 REGION_BEG, REGION_END delimit the region, so it can be
6765 LIMIT is a position not to scan beyond. That is to limit the time
6766 this function can take.
6768 If MOUSE is non-zero, use the character's mouse-face, not its face.
6770 The face returned is suitable for displaying ASCII characters. */
6773 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6774 endptr
, limit
, mouse
)
6777 int region_beg
, region_end
;
6782 struct frame
*f
= XFRAME (w
->frame
);
6783 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6784 Lisp_Object prop
, position
;
6786 Lisp_Object
*overlay_vec
;
6789 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6790 Lisp_Object limit1
, end
;
6791 struct face
*default_face
;
6792 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6794 /* W must display the current buffer. We could write this function
6795 to use the frame and buffer of W, but right now it doesn't. */
6796 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6798 XSETFRAME (frame
, f
);
6799 XSETFASTINT (position
, pos
);
6802 if (pos
< region_beg
&& region_beg
< endpos
)
6803 endpos
= region_beg
;
6805 /* Get the `face' or `mouse_face' text property at POS, and
6806 determine the next position at which the property changes. */
6807 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6808 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6809 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6811 endpos
= XINT (end
);
6813 /* Look at properties from overlays. */
6818 /* First try with room for 40 overlays. */
6820 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6821 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6822 &next_overlay
, NULL
, 0);
6824 /* If there are more than 40, make enough space for all, and try
6826 if (noverlays
> len
)
6829 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6830 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6831 &next_overlay
, NULL
, 0);
6834 if (next_overlay
< endpos
)
6835 endpos
= next_overlay
;
6840 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6842 /* Optimize common cases where we can use the default face. */
6845 && !(pos
>= region_beg
&& pos
< region_end
))
6846 return DEFAULT_FACE_ID
;
6848 /* Begin with attributes from the default face. */
6849 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6851 /* Merge in attributes specified via text properties. */
6853 merge_face_vector_with_property (f
, attrs
, prop
);
6855 /* Now merge the overlay data. */
6856 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6857 for (i
= 0; i
< noverlays
; i
++)
6862 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6864 merge_face_vector_with_property (f
, attrs
, prop
);
6866 oend
= OVERLAY_END (overlay_vec
[i
]);
6867 oendpos
= OVERLAY_POSITION (oend
);
6868 if (oendpos
< endpos
)
6872 /* If in the region, merge in the region face. */
6873 if (pos
>= region_beg
&& pos
< region_end
)
6875 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6876 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6878 if (region_end
< endpos
)
6879 endpos
= region_end
;
6884 /* Look up a realized face with the given face attributes,
6885 or realize a new one for ASCII characters. */
6886 return lookup_face (f
, attrs
, 0, NULL
);
6890 /* Compute the face at character position POS in Lisp string STRING on
6891 window W, for ASCII characters.
6893 If STRING is an overlay string, it comes from position BUFPOS in
6894 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6895 not an overlay string. W must display the current buffer.
6896 REGION_BEG and REGION_END give the start and end positions of the
6897 region; both are -1 if no region is visible.
6899 BASE_FACE_ID is the id of a face to merge with. For strings coming
6900 from overlays or the `display' property it is the face at BUFPOS.
6902 Set *ENDPTR to the next position where to check for faces in
6903 STRING; -1 if the face is constant from POS to the end of the
6906 Value is the id of the face to use. The face returned is suitable
6907 for displaying ASCII characters. */
6910 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6911 region_end
, endptr
, base_face_id
)
6915 int region_beg
, region_end
;
6917 enum face_id base_face_id
;
6919 Lisp_Object prop
, position
, end
, limit
;
6920 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6921 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6922 struct face
*base_face
;
6923 int multibyte_p
= STRING_MULTIBYTE (string
);
6925 /* Get the value of the face property at the current position within
6926 STRING. Value is nil if there is no face property. */
6927 XSETFASTINT (position
, pos
);
6928 prop
= Fget_text_property (position
, Qface
, string
);
6930 /* Get the next position at which to check for faces. Value of end
6931 is nil if face is constant all the way to the end of the string.
6932 Otherwise it is a string position where to check faces next.
6933 Limit is the maximum position up to which to check for property
6934 changes in Fnext_single_property_change. Strings are usually
6935 short, so set the limit to the end of the string. */
6936 XSETFASTINT (limit
, XSTRING (string
)->size
);
6937 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6939 *endptr
= XFASTINT (end
);
6943 base_face
= FACE_FROM_ID (f
, base_face_id
);
6944 xassert (base_face
);
6946 /* Optimize the default case that there is no face property and we
6947 are not in the region. */
6949 && (base_face_id
!= DEFAULT_FACE_ID
6950 /* BUFPOS <= 0 means STRING is not an overlay string, so
6951 that the region doesn't have to be taken into account. */
6953 || bufpos
< region_beg
6954 || bufpos
>= region_end
)
6956 /* We can't realize faces for different charsets differently
6957 if we don't have fonts, so we can stop here if not working
6958 on a window-system frame. */
6959 || !FRAME_WINDOW_P (f
)
6960 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6961 return base_face
->id
;
6963 /* Begin with attributes from the base face. */
6964 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6966 /* Merge in attributes specified via text properties. */
6968 merge_face_vector_with_property (f
, attrs
, prop
);
6970 /* If in the region, merge in the region face. */
6972 && bufpos
>= region_beg
6973 && bufpos
< region_end
)
6975 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6976 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6979 /* Look up a realized face with the given face attributes,
6980 or realize a new one for ASCII characters. */
6981 return lookup_face (f
, attrs
, 0, NULL
);
6986 /***********************************************************************
6988 ***********************************************************************/
6992 /* Print the contents of the realized face FACE to stderr. */
6995 dump_realized_face (face
)
6998 fprintf (stderr
, "ID: %d\n", face
->id
);
6999 #ifdef HAVE_X_WINDOWS
7000 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7002 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7004 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7005 fprintf (stderr
, "background: 0x%lx (%s)\n",
7007 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7008 fprintf (stderr
, "font_name: %s (%s)\n",
7010 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7011 #ifdef HAVE_X_WINDOWS
7012 fprintf (stderr
, "font = %p\n", face
->font
);
7014 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7015 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7016 fprintf (stderr
, "underline: %d (%s)\n",
7018 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7019 fprintf (stderr
, "hash: %d\n", face
->hash
);
7020 fprintf (stderr
, "charset: %d\n", face
->charset
);
7024 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
7032 fprintf (stderr
, "font selection order: ");
7033 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7034 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7035 fprintf (stderr
, "\n");
7037 fprintf (stderr
, "alternative fonts: ");
7038 debug_print (Vface_alternative_font_family_alist
);
7039 fprintf (stderr
, "\n");
7041 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7042 Fdump_face (make_number (i
));
7047 CHECK_NUMBER (n
, 0);
7048 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7050 error ("Not a valid face");
7051 dump_realized_face (face
);
7058 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7062 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7063 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7064 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7068 #endif /* GLYPH_DEBUG != 0 */
7072 /***********************************************************************
7074 ***********************************************************************/
7079 Qface
= intern ("face");
7081 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7082 staticpro (&Qbitmap_spec_p
);
7083 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7084 staticpro (&Qframe_update_face_colors
);
7086 /* Lisp face attribute keywords. */
7087 QCfamily
= intern (":family");
7088 staticpro (&QCfamily
);
7089 QCheight
= intern (":height");
7090 staticpro (&QCheight
);
7091 QCweight
= intern (":weight");
7092 staticpro (&QCweight
);
7093 QCslant
= intern (":slant");
7094 staticpro (&QCslant
);
7095 QCunderline
= intern (":underline");
7096 staticpro (&QCunderline
);
7097 QCinverse_video
= intern (":inverse-video");
7098 staticpro (&QCinverse_video
);
7099 QCreverse_video
= intern (":reverse-video");
7100 staticpro (&QCreverse_video
);
7101 QCforeground
= intern (":foreground");
7102 staticpro (&QCforeground
);
7103 QCbackground
= intern (":background");
7104 staticpro (&QCbackground
);
7105 QCstipple
= intern (":stipple");;
7106 staticpro (&QCstipple
);
7107 QCwidth
= intern (":width");
7108 staticpro (&QCwidth
);
7109 QCfont
= intern (":font");
7110 staticpro (&QCfont
);
7111 QCbold
= intern (":bold");
7112 staticpro (&QCbold
);
7113 QCitalic
= intern (":italic");
7114 staticpro (&QCitalic
);
7115 QCoverline
= intern (":overline");
7116 staticpro (&QCoverline
);
7117 QCstrike_through
= intern (":strike-through");
7118 staticpro (&QCstrike_through
);
7119 QCbox
= intern (":box");
7121 QCinherit
= intern (":inherit");
7122 staticpro (&QCinherit
);
7124 /* Symbols used for Lisp face attribute values. */
7125 QCcolor
= intern (":color");
7126 staticpro (&QCcolor
);
7127 QCline_width
= intern (":line-width");
7128 staticpro (&QCline_width
);
7129 QCstyle
= intern (":style");
7130 staticpro (&QCstyle
);
7131 Qreleased_button
= intern ("released-button");
7132 staticpro (&Qreleased_button
);
7133 Qpressed_button
= intern ("pressed-button");
7134 staticpro (&Qpressed_button
);
7135 Qnormal
= intern ("normal");
7136 staticpro (&Qnormal
);
7137 Qultra_light
= intern ("ultra-light");
7138 staticpro (&Qultra_light
);
7139 Qextra_light
= intern ("extra-light");
7140 staticpro (&Qextra_light
);
7141 Qlight
= intern ("light");
7142 staticpro (&Qlight
);
7143 Qsemi_light
= intern ("semi-light");
7144 staticpro (&Qsemi_light
);
7145 Qsemi_bold
= intern ("semi-bold");
7146 staticpro (&Qsemi_bold
);
7147 Qbold
= intern ("bold");
7149 Qextra_bold
= intern ("extra-bold");
7150 staticpro (&Qextra_bold
);
7151 Qultra_bold
= intern ("ultra-bold");
7152 staticpro (&Qultra_bold
);
7153 Qoblique
= intern ("oblique");
7154 staticpro (&Qoblique
);
7155 Qitalic
= intern ("italic");
7156 staticpro (&Qitalic
);
7157 Qreverse_oblique
= intern ("reverse-oblique");
7158 staticpro (&Qreverse_oblique
);
7159 Qreverse_italic
= intern ("reverse-italic");
7160 staticpro (&Qreverse_italic
);
7161 Qultra_condensed
= intern ("ultra-condensed");
7162 staticpro (&Qultra_condensed
);
7163 Qextra_condensed
= intern ("extra-condensed");
7164 staticpro (&Qextra_condensed
);
7165 Qcondensed
= intern ("condensed");
7166 staticpro (&Qcondensed
);
7167 Qsemi_condensed
= intern ("semi-condensed");
7168 staticpro (&Qsemi_condensed
);
7169 Qsemi_expanded
= intern ("semi-expanded");
7170 staticpro (&Qsemi_expanded
);
7171 Qexpanded
= intern ("expanded");
7172 staticpro (&Qexpanded
);
7173 Qextra_expanded
= intern ("extra-expanded");
7174 staticpro (&Qextra_expanded
);
7175 Qultra_expanded
= intern ("ultra-expanded");
7176 staticpro (&Qultra_expanded
);
7177 Qbackground_color
= intern ("background-color");
7178 staticpro (&Qbackground_color
);
7179 Qforeground_color
= intern ("foreground-color");
7180 staticpro (&Qforeground_color
);
7181 Qunspecified
= intern ("unspecified");
7182 staticpro (&Qunspecified
);
7184 Qface_alias
= intern ("face-alias");
7185 staticpro (&Qface_alias
);
7186 Qdefault
= intern ("default");
7187 staticpro (&Qdefault
);
7188 Qtool_bar
= intern ("tool-bar");
7189 staticpro (&Qtool_bar
);
7190 Qregion
= intern ("region");
7191 staticpro (&Qregion
);
7192 Qfringe
= intern ("fringe");
7193 staticpro (&Qfringe
);
7194 Qheader_line
= intern ("header-line");
7195 staticpro (&Qheader_line
);
7196 Qscroll_bar
= intern ("scroll-bar");
7197 staticpro (&Qscroll_bar
);
7198 Qmenu
= intern ("menu");
7200 Qcursor
= intern ("cursor");
7201 staticpro (&Qcursor
);
7202 Qborder
= intern ("border");
7203 staticpro (&Qborder
);
7204 Qmouse
= intern ("mouse");
7205 staticpro (&Qmouse
);
7206 Qtty_color_desc
= intern ("tty-color-desc");
7207 staticpro (&Qtty_color_desc
);
7208 Qtty_color_by_index
= intern ("tty-color-by-index");
7209 staticpro (&Qtty_color_by_index
);
7210 Qtty_color_alist
= intern ("tty-color-alist");
7211 staticpro (&Qtty_color_alist
);
7213 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7214 staticpro (&Vparam_value_alist
);
7215 Vface_alternative_font_family_alist
= Qnil
;
7216 staticpro (&Vface_alternative_font_family_alist
);
7217 Vface_alternative_font_registry_alist
= Qnil
;
7218 staticpro (&Vface_alternative_font_registry_alist
);
7220 defsubr (&Sinternal_make_lisp_face
);
7221 defsubr (&Sinternal_lisp_face_p
);
7222 defsubr (&Sinternal_set_lisp_face_attribute
);
7223 #ifdef HAVE_WINDOW_SYSTEM
7224 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7226 defsubr (&Scolor_gray_p
);
7227 defsubr (&Scolor_supported_p
);
7228 defsubr (&Sinternal_get_lisp_face_attribute
);
7229 defsubr (&Sinternal_lisp_face_attribute_values
);
7230 defsubr (&Sinternal_lisp_face_equal_p
);
7231 defsubr (&Sinternal_lisp_face_empty_p
);
7232 defsubr (&Sinternal_copy_lisp_face
);
7233 defsubr (&Sinternal_merge_in_global_face
);
7234 defsubr (&Sface_font
);
7235 defsubr (&Sframe_face_alist
);
7236 defsubr (&Sinternal_set_font_selection_order
);
7237 defsubr (&Sinternal_set_alternative_font_family_alist
);
7238 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7240 defsubr (&Sdump_face
);
7241 defsubr (&Sshow_face_resources
);
7242 #endif /* GLYPH_DEBUG */
7243 defsubr (&Sclear_face_cache
);
7244 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7246 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7247 defsubr (&Sdump_colors
);
7250 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7251 "*Limit for font matching.\n\
7252 If an integer > 0, font matching functions won't load more than\n\
7253 that number of fonts when searching for a matching font.");
7254 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7256 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7257 "List of global face definitions (for internal use only.)");
7258 Vface_new_frame_defaults
= Qnil
;
7260 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7261 "*Default stipple pattern used on monochrome displays.\n\
7262 This stipple pattern is used on monochrome displays\n\
7263 instead of shades of gray for a face background color.\n\
7264 See `set-face-stipple' for possible values for this variable.");
7265 Vface_default_stipple
= build_string ("gray3");
7267 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7268 "An alist of defined terminal colors and their RGB values.");
7269 Vtty_defined_color_alist
= Qnil
;
7271 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7272 "Allowed scalable fonts.\n\
7273 A value of nil means don't allow any scalable fonts.\n\
7274 A value of t means allow any scalable font.\n\
7275 Otherwise, value must be a list of regular expressions. A font may be\n\
7276 scaled if its name matches a regular expression in the list.");
7277 #if defined (WINDOWSNT) || defined (macintosh)
7278 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
7279 by default limits the fonts available severely. */
7280 Vscalable_fonts_allowed
= Qt
;
7282 Vscalable_fonts_allowed
= Qnil
;
7285 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7286 "List of ignored fonts.\n\
7287 Each element is a regular expression that matches names of fonts to ignore.");
7288 Vface_ignored_fonts
= Qnil
;
7290 #ifdef HAVE_WINDOW_SYSTEM
7291 defsubr (&Sbitmap_spec_p
);
7292 defsubr (&Sx_list_fonts
);
7293 defsubr (&Sinternal_face_x_get_resource
);
7294 defsubr (&Sx_family_fonts
);
7295 defsubr (&Sx_font_family_list
);
7296 #endif /* HAVE_WINDOW_SYSTEM */