(struct skp): New struct, to pass args through map_keymap.
[emacs.git] / src / xfaces.c
blob4f32e9f9e9067c4f263ff278bb49915c008202d8
1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
24 /* Faces.
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
28 display attributes:
30 1. Font family name.
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
41 6. Foreground color.
43 7. Background color.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
54 color.
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. Font or fontset pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
84 created frames.
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
91 Face merging.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
101 Face realization.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
114 them.
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
129 Unibyte text.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
137 Font selection.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
162 etc.
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
166 face doesn't exist.
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
173 fonts.
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
184 the same.
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
194 #include <config.h>
195 #include <sys/types.h>
196 #include <sys/stat.h>
198 #include "lisp.h"
199 #include "charset.h"
200 #include "keyboard.h"
201 #include "frame.h"
203 #ifdef HAVE_WINDOW_SYSTEM
204 #include "fontset.h"
205 #endif /* HAVE_WINDOW_SYSTEM */
207 #ifdef HAVE_X_WINDOWS
208 #include "xterm.h"
209 #ifdef USE_MOTIF
210 #include <Xm/Xm.h>
211 #include <Xm/XmStrDefs.h>
212 #endif /* USE_MOTIF */
213 #endif /* HAVE_X_WINDOWS */
215 #ifdef MSDOS
216 #include "dosfns.h"
217 #endif
219 #ifdef WINDOWSNT
220 #include "w32term.h"
221 #include "fontset.h"
222 /* Redefine X specifics to W32 equivalents to avoid cluttering the
223 code with #ifdef blocks. */
224 #undef FRAME_X_DISPLAY_INFO
225 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
226 #define x_display_info w32_display_info
227 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
228 #define check_x check_w32
229 #define x_list_fonts w32_list_fonts
230 #define GCGraphicsExposures 0
231 /* For historic reasons, FONT_WIDTH refers to average width on W32,
232 not maximum as on X. Redefine here. */
233 #undef FONT_WIDTH
234 #define FONT_WIDTH FONT_MAX_WIDTH
235 #endif /* WINDOWSNT */
237 #ifdef MAC_OS
238 #include "macterm.h"
239 #define x_display_info mac_display_info
240 #define check_x check_mac
241 #endif /* MAC_OS */
243 #include "buffer.h"
244 #include "dispextern.h"
245 #include "blockinput.h"
246 #include "window.h"
247 #include "intervals.h"
249 #ifdef HAVE_X_WINDOWS
251 /* Compensate for a bug in Xos.h on some systems, on which it requires
252 time.h. On some such systems, Xos.h tries to redefine struct
253 timeval and struct timezone if USG is #defined while it is
254 #included. */
256 #ifdef XOS_NEEDS_TIME_H
257 #include <time.h>
258 #undef USG
259 #include <X11/Xos.h>
260 #define USG
261 #define __TIMEVAL__
262 #else /* not XOS_NEEDS_TIME_H */
263 #include <X11/Xos.h>
264 #endif /* not XOS_NEEDS_TIME_H */
266 #endif /* HAVE_X_WINDOWS */
268 #include <stdio.h>
269 #include <ctype.h>
271 #define abs(X) ((X) < 0 ? -(X) : (X))
273 /* Number of pt per inch (from the TeXbook). */
275 #define PT_PER_INCH 72.27
277 /* Non-zero if face attribute ATTR is unspecified. */
279 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
281 /* Value is the number of elements of VECTOR. */
283 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
285 /* Make a copy of string S on the stack using alloca. Value is a pointer
286 to the copy. */
288 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
290 /* Make a copy of the contents of Lisp string S on the stack using
291 alloca. Value is a pointer to the copy. */
293 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
295 /* Size of hash table of realized faces in face caches (should be a
296 prime number). */
298 #define FACE_CACHE_BUCKETS_SIZE 1001
300 /* Keyword symbols used for face attribute names. */
302 Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
303 Lisp_Object QCinverse_video, QCforeground, QCbackground, QCstipple;
304 Lisp_Object QCwidth, QCfont, QCbold, QCitalic;
305 Lisp_Object QCreverse_video;
306 Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
308 /* Symbols used for attribute values. */
310 Lisp_Object Qnormal, Qbold, Qultra_light, Qextra_light, Qlight;
311 Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
312 Lisp_Object Qoblique, Qitalic, Qreverse_oblique, Qreverse_italic;
313 Lisp_Object Qultra_condensed, Qextra_condensed, Qcondensed;
314 Lisp_Object Qsemi_condensed, Qsemi_expanded, Qexpanded, Qextra_expanded;
315 Lisp_Object Qultra_expanded;
316 Lisp_Object Qreleased_button, Qpressed_button;
317 Lisp_Object QCstyle, QCcolor, QCline_width;
318 Lisp_Object Qunspecified;
320 char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
322 /* The name of the function to call when the background of the frame
323 has changed, frame_update_face_colors. */
325 Lisp_Object Qframe_update_face_colors;
327 /* Names of basic faces. */
329 Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
330 Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
331 Lisp_Object Qmode_line_inactive;
332 extern Lisp_Object Qmode_line;
334 /* The symbol `face-alias'. A symbols having that property is an
335 alias for another face. Value of the property is the name of
336 the aliased face. */
338 Lisp_Object Qface_alias;
340 /* Default stipple pattern used on monochrome displays. This stipple
341 pattern is used on monochrome displays instead of shades of gray
342 for a face background color. See `set-face-stipple' for possible
343 values for this variable. */
345 Lisp_Object Vface_default_stipple;
347 /* Alist of alternative font families. Each element is of the form
348 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
349 try FAMILY1, then FAMILY2, ... */
351 Lisp_Object Vface_alternative_font_family_alist;
353 /* Alist of alternative font registries. Each element is of the form
354 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
355 loaded, try REGISTRY1, then REGISTRY2, ... */
357 Lisp_Object Vface_alternative_font_registry_alist;
359 /* Allowed scalable fonts. A value of nil means don't allow any
360 scalable fonts. A value of t means allow the use of any scalable
361 font. Otherwise, value must be a list of regular expressions. A
362 font may be scaled if its name matches a regular expression in the
363 list. */
365 Lisp_Object Vscalable_fonts_allowed, Qscalable_fonts_allowed;
367 /* List of regular expressions that matches names of fonts to ignore. */
369 Lisp_Object Vface_ignored_fonts;
371 /* Alist of font name patterns vs the rescaling factor. */
373 Lisp_Object Vface_font_rescale_alist;
375 /* Maximum number of fonts to consider in font_list. If not an
376 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
378 Lisp_Object Vfont_list_limit;
379 #define DEFAULT_FONT_LIST_LIMIT 100
381 /* The symbols `foreground-color' and `background-color' which can be
382 used as part of a `face' property. This is for compatibility with
383 Emacs 20.2. */
385 Lisp_Object Qforeground_color, Qbackground_color;
387 /* The symbols `face' and `mouse-face' used as text properties. */
389 Lisp_Object Qface;
390 extern Lisp_Object Qmouse_face;
392 /* Error symbol for wrong_type_argument in load_pixmap. */
394 Lisp_Object Qbitmap_spec_p;
396 /* Alist of global face definitions. Each element is of the form
397 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
398 is a Lisp vector of face attributes. These faces are used
399 to initialize faces for new frames. */
401 Lisp_Object Vface_new_frame_defaults;
403 /* The next ID to assign to Lisp faces. */
405 static int next_lface_id;
407 /* A vector mapping Lisp face Id's to face names. */
409 static Lisp_Object *lface_id_to_name;
410 static int lface_id_to_name_size;
412 /* TTY color-related functions (defined in tty-colors.el). */
414 Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
416 /* The name of the function used to compute colors on TTYs. */
418 Lisp_Object Qtty_color_alist;
420 /* An alist of defined terminal colors and their RGB values. */
422 Lisp_Object Vtty_defined_color_alist;
424 /* Counter for calls to clear_face_cache. If this counter reaches
425 CLEAR_FONT_TABLE_COUNT, and a frame has more than
426 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
428 static int clear_font_table_count;
429 #define CLEAR_FONT_TABLE_COUNT 100
430 #define CLEAR_FONT_TABLE_NFONTS 10
432 /* Non-zero means face attributes have been changed since the last
433 redisplay. Used in redisplay_internal. */
435 int face_change_count;
437 /* Non-zero means don't display bold text if a face's foreground
438 and background colors are the inverse of the default colors of the
439 display. This is a kluge to suppress `bold black' foreground text
440 which is hard to read on an LCD monitor. */
442 int tty_suppress_bold_inverse_default_colors_p;
444 /* A list of the form `((x . y))' used to avoid consing in
445 Finternal_set_lisp_face_attribute. */
447 static Lisp_Object Vparam_value_alist;
449 /* The total number of colors currently allocated. */
451 #if GLYPH_DEBUG
452 static int ncolors_allocated;
453 static int npixmaps_allocated;
454 static int ngcs;
455 #endif
457 /* Non-zero means the definition of the `menu' face for new frames has
458 been changed. */
460 int menu_face_changed_default;
463 /* Function prototypes. */
465 struct font_name;
466 struct table_entry;
468 static void map_tty_color P_ ((struct frame *, struct face *,
469 enum lface_attribute_index, int *));
470 static Lisp_Object resolve_face_name P_ ((Lisp_Object));
471 static int may_use_scalable_font_p P_ ((const char *));
472 static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
473 static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
474 int, int));
475 static int x_face_list_fonts P_ ((struct frame *, char *,
476 struct font_name **, int, int));
477 static int font_scalable_p P_ ((struct font_name *));
478 static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
479 static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
480 static unsigned char *xstrlwr P_ ((unsigned char *));
481 static void signal_error P_ ((char *, Lisp_Object));
482 static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
483 static void load_face_font P_ ((struct frame *, struct face *, int));
484 static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
485 static void free_face_colors P_ ((struct frame *, struct face *));
486 static int face_color_gray_p P_ ((struct frame *, char *));
487 static char *build_font_name P_ ((struct font_name *));
488 static void free_font_names P_ ((struct font_name *, int));
489 static int sorted_font_list P_ ((struct frame *, char *,
490 int (*cmpfn) P_ ((const void *, const void *)),
491 struct font_name **));
492 static int font_list_1 P_ ((struct frame *, Lisp_Object, Lisp_Object,
493 Lisp_Object, struct font_name **));
494 static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object,
495 Lisp_Object, struct font_name **));
496 static int try_font_list P_ ((struct frame *, Lisp_Object *,
497 Lisp_Object, Lisp_Object, struct font_name **,
498 int));
499 static int try_alternative_families P_ ((struct frame *f, Lisp_Object,
500 Lisp_Object, struct font_name **));
501 static int cmp_font_names P_ ((const void *, const void *));
502 static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, int,
503 struct face *, int));
504 static struct face *realize_x_face P_ ((struct face_cache *,
505 Lisp_Object *, int, struct face *));
506 static struct face *realize_tty_face P_ ((struct face_cache *,
507 Lisp_Object *, int));
508 static int realize_basic_faces P_ ((struct frame *));
509 static int realize_default_face P_ ((struct frame *));
510 static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
511 static int lface_fully_specified_p P_ ((Lisp_Object *));
512 static int lface_equal_p P_ ((Lisp_Object *, Lisp_Object *));
513 static unsigned hash_string_case_insensitive P_ ((Lisp_Object));
514 static unsigned lface_hash P_ ((Lisp_Object *));
515 static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *));
516 static struct face_cache *make_face_cache P_ ((struct frame *));
517 static void free_realized_face P_ ((struct frame *, struct face *));
518 static void clear_face_gcs P_ ((struct face_cache *));
519 static void free_face_cache P_ ((struct face_cache *));
520 static int face_numeric_weight P_ ((Lisp_Object));
521 static int face_numeric_slant P_ ((Lisp_Object));
522 static int face_numeric_swidth P_ ((Lisp_Object));
523 static int face_fontset P_ ((Lisp_Object *));
524 static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int, int*));
525 static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, Lisp_Object));
526 static void merge_face_inheritance P_ ((struct frame *f, Lisp_Object,
527 Lisp_Object *, Lisp_Object));
528 static void merge_face_vector_with_property P_ ((struct frame *, Lisp_Object *,
529 Lisp_Object));
530 static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object,
531 Lisp_Object, int, int));
532 static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
533 static struct face *make_realized_face P_ ((Lisp_Object *));
534 static void free_realized_faces P_ ((struct face_cache *));
535 static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
536 struct font_name *, int, int, int *));
537 static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
538 static void uncache_face P_ ((struct face_cache *, struct face *));
539 static int xlfd_numeric_slant P_ ((struct font_name *));
540 static int xlfd_numeric_weight P_ ((struct font_name *));
541 static int xlfd_numeric_swidth P_ ((struct font_name *));
542 static Lisp_Object xlfd_symbolic_slant P_ ((struct font_name *));
543 static Lisp_Object xlfd_symbolic_weight P_ ((struct font_name *));
544 static Lisp_Object xlfd_symbolic_swidth P_ ((struct font_name *));
545 static int xlfd_fixed_p P_ ((struct font_name *));
546 static int xlfd_numeric_value P_ ((struct table_entry *, int, struct font_name *,
547 int, int));
548 static Lisp_Object xlfd_symbolic_value P_ ((struct table_entry *, int,
549 struct font_name *, int,
550 Lisp_Object));
551 static struct table_entry *xlfd_lookup_field_contents P_ ((struct table_entry *, int,
552 struct font_name *, int));
554 #ifdef HAVE_WINDOW_SYSTEM
556 static int split_font_name P_ ((struct frame *, struct font_name *, int));
557 static int xlfd_point_size P_ ((struct frame *, struct font_name *));
558 static void sort_fonts P_ ((struct frame *, struct font_name *, int,
559 int (*cmpfn) P_ ((const void *, const void *))));
560 static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
561 static void x_free_gc P_ ((struct frame *, GC));
562 static void clear_font_table P_ ((struct x_display_info *));
564 #ifdef WINDOWSNT
565 extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
566 #endif /* WINDOWSNT */
568 #ifdef USE_X_TOOLKIT
569 static void x_update_menu_appearance P_ ((struct frame *));
571 extern void free_frame_menubar P_ ((struct frame *));
572 #endif /* USE_X_TOOLKIT */
574 #endif /* HAVE_WINDOW_SYSTEM */
577 /***********************************************************************
578 Utilities
579 ***********************************************************************/
581 #ifdef HAVE_X_WINDOWS
583 #ifdef DEBUG_X_COLORS
585 /* The following is a poor mans infrastructure for debugging X color
586 allocation problems on displays with PseudoColor-8. Some X servers
587 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
588 color reference counts completely so that they don't signal an
589 error when a color is freed whose reference count is already 0.
590 Other X servers do. To help me debug this, the following code
591 implements a simple reference counting schema of its own, for a
592 single display/screen. --gerd. */
594 /* Reference counts for pixel colors. */
596 int color_count[256];
598 /* Register color PIXEL as allocated. */
600 void
601 register_color (pixel)
602 unsigned long pixel;
604 xassert (pixel < 256);
605 ++color_count[pixel];
609 /* Register color PIXEL as deallocated. */
611 void
612 unregister_color (pixel)
613 unsigned long pixel;
615 xassert (pixel < 256);
616 if (color_count[pixel] > 0)
617 --color_count[pixel];
618 else
619 abort ();
623 /* Register N colors from PIXELS as deallocated. */
625 void
626 unregister_colors (pixels, n)
627 unsigned long *pixels;
628 int n;
630 int i;
631 for (i = 0; i < n; ++i)
632 unregister_color (pixels[i]);
636 DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
637 doc: /* Dump currently allocated colors to stderr. */)
640 int i, n;
642 fputc ('\n', stderr);
644 for (i = n = 0; i < sizeof color_count / sizeof color_count[0]; ++i)
645 if (color_count[i])
647 fprintf (stderr, "%3d: %5d", i, color_count[i]);
648 ++n;
649 if (n % 5 == 0)
650 fputc ('\n', stderr);
651 else
652 fputc ('\t', stderr);
655 if (n % 5 != 0)
656 fputc ('\n', stderr);
657 return Qnil;
660 #endif /* DEBUG_X_COLORS */
663 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
664 color values. Interrupt input must be blocked when this function
665 is called. */
667 void
668 x_free_colors (f, pixels, npixels)
669 struct frame *f;
670 unsigned long *pixels;
671 int npixels;
673 int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
675 /* If display has an immutable color map, freeing colors is not
676 necessary and some servers don't allow it. So don't do it. */
677 if (class != StaticColor && class != StaticGray && class != TrueColor)
679 #ifdef DEBUG_X_COLORS
680 unregister_colors (pixels, npixels);
681 #endif
682 XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
683 pixels, npixels, 0);
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
690 is called. */
692 void
693 x_free_dpy_colors (dpy, screen, cmap, pixels, npixels)
694 Display *dpy;
695 Screen *screen;
696 Colormap cmap;
697 unsigned long *pixels;
698 int npixels;
700 struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
701 int class = dpyinfo->visual->class;
703 /* If display has an immutable color map, freeing colors is not
704 necessary and some servers don't allow it. So don't do it. */
705 if (class != StaticColor && class != StaticGray && class != TrueColor)
707 #ifdef DEBUG_X_COLORS
708 unregister_colors (pixels, npixels);
709 #endif
710 XFreeColors (dpy, cmap, pixels, npixels, 0);
715 /* Create and return a GC for use on frame F. GC values and mask
716 are given by XGCV and MASK. */
718 static INLINE GC
719 x_create_gc (f, mask, xgcv)
720 struct frame *f;
721 unsigned long mask;
722 XGCValues *xgcv;
724 GC gc;
725 BLOCK_INPUT;
726 gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
727 UNBLOCK_INPUT;
728 IF_DEBUG (++ngcs);
729 return gc;
733 /* Free GC which was used on frame F. */
735 static INLINE void
736 x_free_gc (f, gc)
737 struct frame *f;
738 GC gc;
740 BLOCK_INPUT;
741 xassert (--ngcs >= 0);
742 XFreeGC (FRAME_X_DISPLAY (f), gc);
743 UNBLOCK_INPUT;
746 #endif /* HAVE_X_WINDOWS */
748 #ifdef WINDOWSNT
749 /* W32 emulation of GCs */
751 static INLINE GC
752 x_create_gc (f, mask, xgcv)
753 struct frame *f;
754 unsigned long mask;
755 XGCValues *xgcv;
757 GC gc;
758 BLOCK_INPUT;
759 gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, xgcv);
760 UNBLOCK_INPUT;
761 IF_DEBUG (++ngcs);
762 return gc;
766 /* Free GC which was used on frame F. */
768 static INLINE void
769 x_free_gc (f, gc)
770 struct frame *f;
771 GC gc;
773 BLOCK_INPUT;
774 xassert (--ngcs >= 0);
775 xfree (gc);
776 UNBLOCK_INPUT;
779 #endif /* WINDOWSNT */
781 #ifdef MAC_OS
782 /* Mac OS emulation of GCs */
784 extern XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
786 static INLINE GC
787 x_create_gc (f, mask, xgcv)
788 struct frame *f;
789 unsigned long mask;
790 XGCValues *xgcv;
792 GC gc;
793 gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
794 return gc;
797 static INLINE void
798 x_free_gc (f, gc)
799 struct frame *f;
800 GC gc;
802 XFreeGC (FRAME_MAC_DISPLAY (f), gc);
805 #endif /* MAC_OS */
807 /* Like stricmp. Used to compare parts of font names which are in
808 ISO8859-1. */
811 xstricmp (s1, s2)
812 const unsigned char *s1, *s2;
814 while (*s1 && *s2)
816 unsigned char c1 = tolower (*s1);
817 unsigned char c2 = tolower (*s2);
818 if (c1 != c2)
819 return c1 < c2 ? -1 : 1;
820 ++s1, ++s2;
823 if (*s1 == 0)
824 return *s2 == 0 ? 0 : -1;
825 return 1;
829 /* Like strlwr, which might not always be available. */
831 static unsigned char *
832 xstrlwr (s)
833 unsigned char *s;
835 unsigned char *p = s;
837 for (p = s; *p; ++p)
838 *p = tolower (*p);
840 return s;
844 /* Signal `error' with message S, and additional argument ARG. */
846 static void
847 signal_error (s, arg)
848 char *s;
849 Lisp_Object arg;
851 Fsignal (Qerror, Fcons (build_string (s), Fcons (arg, Qnil)));
855 /* If FRAME is nil, return a pointer to the selected frame.
856 Otherwise, check that FRAME is a live frame, and return a pointer
857 to it. NPARAM is the parameter number of FRAME, for
858 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
859 Lisp function definitions. */
861 static INLINE struct frame *
862 frame_or_selected_frame (frame, nparam)
863 Lisp_Object frame;
864 int nparam;
866 if (NILP (frame))
867 frame = selected_frame;
869 CHECK_LIVE_FRAME (frame);
870 return XFRAME (frame);
874 /***********************************************************************
875 Frames and faces
876 ***********************************************************************/
878 /* Initialize face cache and basic faces for frame F. */
880 void
881 init_frame_faces (f)
882 struct frame *f;
884 /* Make a face cache, if F doesn't have one. */
885 if (FRAME_FACE_CACHE (f) == NULL)
886 FRAME_FACE_CACHE (f) = make_face_cache (f);
888 #ifdef HAVE_WINDOW_SYSTEM
889 /* Make the image cache. */
890 if (FRAME_WINDOW_P (f))
892 if (FRAME_X_IMAGE_CACHE (f) == NULL)
893 FRAME_X_IMAGE_CACHE (f) = make_image_cache ();
894 ++FRAME_X_IMAGE_CACHE (f)->refcount;
896 #endif /* HAVE_WINDOW_SYSTEM */
898 /* Realize basic faces. Must have enough information in frame
899 parameters to realize basic faces at this point. */
900 #ifdef HAVE_X_WINDOWS
901 if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
902 #endif
903 #ifdef WINDOWSNT
904 if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
905 #endif
906 #ifdef MAC_OS
907 if (!FRAME_MAC_P (f) || FRAME_MAC_WINDOW (f))
908 #endif
909 if (!realize_basic_faces (f))
910 abort ();
914 /* Free face cache of frame F. Called from Fdelete_frame. */
916 void
917 free_frame_faces (f)
918 struct frame *f;
920 struct face_cache *face_cache = FRAME_FACE_CACHE (f);
922 if (face_cache)
924 free_face_cache (face_cache);
925 FRAME_FACE_CACHE (f) = NULL;
928 #ifdef HAVE_WINDOW_SYSTEM
929 if (FRAME_WINDOW_P (f))
931 struct image_cache *image_cache = FRAME_X_IMAGE_CACHE (f);
932 if (image_cache)
934 --image_cache->refcount;
935 if (image_cache->refcount == 0)
936 free_image_cache (f);
939 #endif /* HAVE_WINDOW_SYSTEM */
943 /* Clear face caches, and recompute basic faces for frame F. Call
944 this after changing frame parameters on which those faces depend,
945 or when realized faces have been freed due to changing attributes
946 of named faces. */
948 void
949 recompute_basic_faces (f)
950 struct frame *f;
952 if (FRAME_FACE_CACHE (f))
954 clear_face_cache (0);
955 if (!realize_basic_faces (f))
956 abort ();
961 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
962 try to free unused fonts, too. */
964 void
965 clear_face_cache (clear_fonts_p)
966 int clear_fonts_p;
968 #ifdef HAVE_WINDOW_SYSTEM
969 Lisp_Object tail, frame;
970 struct frame *f;
972 if (clear_fonts_p
973 || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
975 struct x_display_info *dpyinfo;
977 /* Fonts are common for frames on one display, i.e. on
978 one X screen. */
979 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
980 if (dpyinfo->n_fonts > CLEAR_FONT_TABLE_NFONTS)
981 clear_font_table (dpyinfo);
983 /* From time to time see if we can unload some fonts. This also
984 frees all realized faces on all frames. Fonts needed by
985 faces will be loaded again when faces are realized again. */
986 clear_font_table_count = 0;
988 FOR_EACH_FRAME (tail, frame)
990 struct frame *f = XFRAME (frame);
991 if (FRAME_WINDOW_P (f)
992 && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
993 free_all_realized_faces (frame);
996 else
998 /* Clear GCs of realized faces. */
999 FOR_EACH_FRAME (tail, frame)
1001 f = XFRAME (frame);
1002 if (FRAME_WINDOW_P (f))
1004 clear_face_gcs (FRAME_FACE_CACHE (f));
1005 clear_image_cache (f, 0);
1009 #endif /* HAVE_WINDOW_SYSTEM */
1013 DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
1014 doc: /* Clear face caches on all frames.
1015 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1016 (thoroughly)
1017 Lisp_Object thoroughly;
1019 clear_face_cache (!NILP (thoroughly));
1020 ++face_change_count;
1021 ++windows_or_buffers_changed;
1022 return Qnil;
1027 #ifdef HAVE_WINDOW_SYSTEM
1030 /* Remove fonts from the font table of DPYINFO except for the default
1031 ASCII fonts of frames on that display. Called from clear_face_cache
1032 from time to time. */
1034 static void
1035 clear_font_table (dpyinfo)
1036 struct x_display_info *dpyinfo;
1038 int i;
1040 /* Free those fonts that are not used by frames on DPYINFO. */
1041 for (i = 0; i < dpyinfo->n_fonts; ++i)
1043 struct font_info *font_info = dpyinfo->font_table + i;
1044 Lisp_Object tail, frame;
1046 /* Check if slot is already free. */
1047 if (font_info->name == NULL)
1048 continue;
1050 /* Don't free a default font of some frame. */
1051 FOR_EACH_FRAME (tail, frame)
1053 struct frame *f = XFRAME (frame);
1054 if (FRAME_WINDOW_P (f)
1055 && font_info->font == FRAME_FONT (f))
1056 break;
1059 if (!NILP (tail))
1060 continue;
1062 /* Free names. */
1063 if (font_info->full_name != font_info->name)
1064 xfree (font_info->full_name);
1065 xfree (font_info->name);
1067 /* Free the font. */
1068 BLOCK_INPUT;
1069 #ifdef HAVE_X_WINDOWS
1070 XFreeFont (dpyinfo->display, font_info->font);
1071 #endif
1072 #ifdef WINDOWSNT
1073 w32_unload_font (dpyinfo, font_info->font);
1074 #endif
1075 UNBLOCK_INPUT;
1077 /* Mark font table slot free. */
1078 font_info->font = NULL;
1079 font_info->name = font_info->full_name = NULL;
1083 #endif /* HAVE_WINDOW_SYSTEM */
1087 /***********************************************************************
1088 X Pixmaps
1089 ***********************************************************************/
1091 #ifdef HAVE_WINDOW_SYSTEM
1093 DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
1094 doc: /* Value is non-nil if OBJECT is a valid bitmap specification.
1095 A bitmap specification is either a string, a file name, or a list
1096 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1097 HEIGHT is its height, and DATA is a string containing the bits of
1098 the pixmap. Bits are stored row by row, each row occupies
1099 \(WIDTH + 7)/8 bytes. */)
1100 (object)
1101 Lisp_Object object;
1103 int pixmap_p = 0;
1105 if (STRINGP (object))
1106 /* If OBJECT is a string, it's a file name. */
1107 pixmap_p = 1;
1108 else if (CONSP (object))
1110 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1111 HEIGHT must be integers > 0, and DATA must be string large
1112 enough to hold a bitmap of the specified size. */
1113 Lisp_Object width, height, data;
1115 height = width = data = Qnil;
1117 if (CONSP (object))
1119 width = XCAR (object);
1120 object = XCDR (object);
1121 if (CONSP (object))
1123 height = XCAR (object);
1124 object = XCDR (object);
1125 if (CONSP (object))
1126 data = XCAR (object);
1130 if (NATNUMP (width) && NATNUMP (height) && STRINGP (data))
1132 int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
1133 / BITS_PER_CHAR);
1134 if (SBYTES (data) >= bytes_per_row * XINT (height))
1135 pixmap_p = 1;
1139 return pixmap_p ? Qt : Qnil;
1143 /* Load a bitmap according to NAME (which is either a file name or a
1144 pixmap spec) for use on frame F. Value is the bitmap_id (see
1145 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1146 bitmap cannot be loaded, display a message saying so, and return
1147 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1148 if these pointers are not null. */
1150 static int
1151 load_pixmap (f, name, w_ptr, h_ptr)
1152 FRAME_PTR f;
1153 Lisp_Object name;
1154 unsigned int *w_ptr, *h_ptr;
1156 int bitmap_id;
1157 Lisp_Object tem;
1159 if (NILP (name))
1160 return 0;
1162 tem = Fbitmap_spec_p (name);
1163 if (NILP (tem))
1164 wrong_type_argument (Qbitmap_spec_p, name);
1166 BLOCK_INPUT;
1167 if (CONSP (name))
1169 /* Decode a bitmap spec into a bitmap. */
1171 int h, w;
1172 Lisp_Object bits;
1174 w = XINT (Fcar (name));
1175 h = XINT (Fcar (Fcdr (name)));
1176 bits = Fcar (Fcdr (Fcdr (name)));
1178 bitmap_id = x_create_bitmap_from_data (f, SDATA (bits),
1179 w, h);
1181 else
1183 /* It must be a string -- a file name. */
1184 bitmap_id = x_create_bitmap_from_file (f, name);
1186 UNBLOCK_INPUT;
1188 if (bitmap_id < 0)
1190 add_to_log ("Invalid or undefined bitmap %s", name, Qnil);
1191 bitmap_id = 0;
1193 if (w_ptr)
1194 *w_ptr = 0;
1195 if (h_ptr)
1196 *h_ptr = 0;
1198 else
1200 #if GLYPH_DEBUG
1201 ++npixmaps_allocated;
1202 #endif
1203 if (w_ptr)
1204 *w_ptr = x_bitmap_width (f, bitmap_id);
1206 if (h_ptr)
1207 *h_ptr = x_bitmap_height (f, bitmap_id);
1210 return bitmap_id;
1213 #endif /* HAVE_WINDOW_SYSTEM */
1217 /***********************************************************************
1218 Minimum font bounds
1219 ***********************************************************************/
1221 #ifdef HAVE_WINDOW_SYSTEM
1223 /* Update the line_height of frame F. Return non-zero if line height
1224 changes. */
1227 frame_update_line_height (f)
1228 struct frame *f;
1230 int line_height, changed_p;
1232 line_height = FONT_HEIGHT (FRAME_FONT (f));
1233 changed_p = line_height != FRAME_LINE_HEIGHT (f);
1234 FRAME_LINE_HEIGHT (f) = line_height;
1235 return changed_p;
1238 #endif /* HAVE_WINDOW_SYSTEM */
1241 /***********************************************************************
1242 Fonts
1243 ***********************************************************************/
1245 #ifdef HAVE_WINDOW_SYSTEM
1247 /* Load font of face FACE which is used on frame F to display
1248 character C. The name of the font to load is determined by lface
1249 and fontset of FACE. */
1251 static void
1252 load_face_font (f, face, c)
1253 struct frame *f;
1254 struct face *face;
1255 int c;
1257 struct font_info *font_info = NULL;
1258 char *font_name;
1259 int needs_overstrike;
1261 face->font_info_id = -1;
1262 face->font = NULL;
1264 font_name = choose_face_font (f, face->lface, face->fontset, c,
1265 &needs_overstrike);
1266 if (!font_name)
1267 return;
1269 BLOCK_INPUT;
1270 font_info = FS_LOAD_FACE_FONT (f, c, font_name, face);
1271 UNBLOCK_INPUT;
1273 if (font_info)
1275 face->font_info_id = font_info->font_idx;
1276 face->font = font_info->font;
1277 face->font_name = font_info->full_name;
1278 face->overstrike = needs_overstrike;
1279 if (face->gc)
1281 x_free_gc (f, face->gc);
1282 face->gc = 0;
1285 else
1286 add_to_log ("Unable to load font %s",
1287 build_string (font_name), Qnil);
1288 xfree (font_name);
1291 #endif /* HAVE_WINDOW_SYSTEM */
1295 /***********************************************************************
1296 X Colors
1297 ***********************************************************************/
1299 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1300 RGB_LIST should contain (at least) 3 lisp integers.
1301 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1303 static int
1304 parse_rgb_list (rgb_list, color)
1305 Lisp_Object rgb_list;
1306 XColor *color;
1308 #define PARSE_RGB_LIST_FIELD(field) \
1309 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1311 color->field = XINT (XCAR (rgb_list)); \
1312 rgb_list = XCDR (rgb_list); \
1314 else \
1315 return 0;
1317 PARSE_RGB_LIST_FIELD (red);
1318 PARSE_RGB_LIST_FIELD (green);
1319 PARSE_RGB_LIST_FIELD (blue);
1321 return 1;
1325 /* Lookup on frame F the color described by the lisp string COLOR.
1326 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1327 non-zero, then the `standard' definition of the same color is
1328 returned in it. */
1330 static int
1331 tty_lookup_color (f, color, tty_color, std_color)
1332 struct frame *f;
1333 Lisp_Object color;
1334 XColor *tty_color, *std_color;
1336 Lisp_Object frame, color_desc;
1338 if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc)))
1339 return 0;
1341 XSETFRAME (frame, f);
1343 color_desc = call2 (Qtty_color_desc, color, frame);
1344 if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
1346 Lisp_Object rgb;
1348 if (! INTEGERP (XCAR (XCDR (color_desc))))
1349 return 0;
1351 tty_color->pixel = XINT (XCAR (XCDR (color_desc)));
1353 rgb = XCDR (XCDR (color_desc));
1354 if (! parse_rgb_list (rgb, tty_color))
1355 return 0;
1357 /* Should we fill in STD_COLOR too? */
1358 if (std_color)
1360 /* Default STD_COLOR to the same as TTY_COLOR. */
1361 *std_color = *tty_color;
1363 /* Do a quick check to see if the returned descriptor is
1364 actually _exactly_ equal to COLOR, otherwise we have to
1365 lookup STD_COLOR separately. If it's impossible to lookup
1366 a standard color, we just give up and use TTY_COLOR. */
1367 if ((!STRINGP (XCAR (color_desc))
1368 || NILP (Fstring_equal (color, XCAR (color_desc))))
1369 && !NILP (Ffboundp (Qtty_color_standard_values)))
1371 /* Look up STD_COLOR separately. */
1372 rgb = call1 (Qtty_color_standard_values, color);
1373 if (! parse_rgb_list (rgb, std_color))
1374 return 0;
1378 return 1;
1380 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1381 /* We were called early during startup, and the colors are not
1382 yet set up in tty-defined-color-alist. Don't return a failure
1383 indication, since this produces the annoying "Unable to
1384 load color" messages in the *Messages* buffer. */
1385 return 1;
1386 else
1387 /* tty-color-desc seems to have returned a bad value. */
1388 return 0;
1391 /* A version of defined_color for non-X frames. */
1394 tty_defined_color (f, color_name, color_def, alloc)
1395 struct frame *f;
1396 char *color_name;
1397 XColor *color_def;
1398 int alloc;
1400 int status = 1;
1402 /* Defaults. */
1403 color_def->pixel = FACE_TTY_DEFAULT_COLOR;
1404 color_def->red = 0;
1405 color_def->blue = 0;
1406 color_def->green = 0;
1408 if (*color_name)
1409 status = tty_lookup_color (f, build_string (color_name), color_def, 0);
1411 if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
1413 if (strcmp (color_name, "unspecified-fg") == 0)
1414 color_def->pixel = FACE_TTY_DEFAULT_FG_COLOR;
1415 else if (strcmp (color_name, "unspecified-bg") == 0)
1416 color_def->pixel = FACE_TTY_DEFAULT_BG_COLOR;
1419 if (color_def->pixel != FACE_TTY_DEFAULT_COLOR)
1420 status = 1;
1422 return status;
1426 /* Decide if color named COLOR_NAME is valid for the display
1427 associated with the frame F; if so, return the rgb values in
1428 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1430 This does the right thing for any type of frame. */
1433 defined_color (f, color_name, color_def, alloc)
1434 struct frame *f;
1435 char *color_name;
1436 XColor *color_def;
1437 int alloc;
1439 if (!FRAME_WINDOW_P (f))
1440 return tty_defined_color (f, color_name, color_def, alloc);
1441 #ifdef HAVE_X_WINDOWS
1442 else if (FRAME_X_P (f))
1443 return x_defined_color (f, color_name, color_def, alloc);
1444 #endif
1445 #ifdef WINDOWSNT
1446 else if (FRAME_W32_P (f))
1447 return w32_defined_color (f, color_name, color_def, alloc);
1448 #endif
1449 #ifdef MAC_OS
1450 else if (FRAME_MAC_P (f))
1451 return mac_defined_color (f, color_name, color_def, alloc);
1452 #endif
1453 else
1454 abort ();
1458 /* Given the index IDX of a tty color on frame F, return its name, a
1459 Lisp string. */
1461 Lisp_Object
1462 tty_color_name (f, idx)
1463 struct frame *f;
1464 int idx;
1466 if (idx >= 0 && !NILP (Ffboundp (Qtty_color_by_index)))
1468 Lisp_Object frame;
1469 Lisp_Object coldesc;
1471 XSETFRAME (frame, f);
1472 coldesc = call2 (Qtty_color_by_index, make_number (idx), frame);
1474 if (!NILP (coldesc))
1475 return XCAR (coldesc);
1477 #ifdef MSDOS
1478 /* We can have an MSDOG frame under -nw for a short window of
1479 opportunity before internal_terminal_init is called. DTRT. */
1480 if (FRAME_MSDOS_P (f) && !inhibit_window_system)
1481 return msdos_stdcolor_name (idx);
1482 #endif
1484 if (idx == FACE_TTY_DEFAULT_FG_COLOR)
1485 return build_string (unspecified_fg);
1486 if (idx == FACE_TTY_DEFAULT_BG_COLOR)
1487 return build_string (unspecified_bg);
1489 #ifdef WINDOWSNT
1490 return vga_stdcolor_name (idx);
1491 #endif
1493 return Qunspecified;
1497 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1498 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1500 static int
1501 face_color_gray_p (f, color_name)
1502 struct frame *f;
1503 char *color_name;
1505 XColor color;
1506 int gray_p;
1508 if (defined_color (f, color_name, &color, 0))
1509 gray_p = ((abs (color.red - color.green)
1510 < max (color.red, color.green) / 20)
1511 && (abs (color.green - color.blue)
1512 < max (color.green, color.blue) / 20)
1513 && (abs (color.blue - color.red)
1514 < max (color.blue, color.red) / 20));
1515 else
1516 gray_p = 0;
1518 return gray_p;
1522 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1523 BACKGROUND_P non-zero means the color will be used as background
1524 color. */
1526 static int
1527 face_color_supported_p (f, color_name, background_p)
1528 struct frame *f;
1529 char *color_name;
1530 int background_p;
1532 Lisp_Object frame;
1533 XColor not_used;
1535 XSETFRAME (frame, f);
1536 return (FRAME_WINDOW_P (f)
1537 ? (!NILP (Fxw_display_color_p (frame))
1538 || xstricmp (color_name, "black") == 0
1539 || xstricmp (color_name, "white") == 0
1540 || (background_p
1541 && face_color_gray_p (f, color_name))
1542 || (!NILP (Fx_display_grayscale_p (frame))
1543 && face_color_gray_p (f, color_name)))
1544 : tty_defined_color (f, color_name, &not_used, 0));
1548 DEFUN ("color-gray-p", Fcolor_gray_p, Scolor_gray_p, 1, 2, 0,
1549 doc: /* Return non-nil if COLOR is a shade of gray (or white or black).
1550 FRAME specifies the frame and thus the display for interpreting COLOR.
1551 If FRAME is nil or omitted, use the selected frame. */)
1552 (color, frame)
1553 Lisp_Object color, frame;
1555 struct frame *f;
1557 CHECK_FRAME (frame);
1558 CHECK_STRING (color);
1559 f = XFRAME (frame);
1560 return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil;
1564 DEFUN ("color-supported-p", Fcolor_supported_p,
1565 Scolor_supported_p, 1, 3, 0,
1566 doc: /* Return non-nil if COLOR can be displayed on FRAME.
1567 BACKGROUND-P non-nil means COLOR is used as a background.
1568 If FRAME is nil or omitted, use the selected frame.
1569 COLOR must be a valid color name. */)
1570 (color, frame, background_p)
1571 Lisp_Object frame, color, background_p;
1573 struct frame *f;
1575 CHECK_FRAME (frame);
1576 CHECK_STRING (color);
1577 f = XFRAME (frame);
1578 if (face_color_supported_p (f, SDATA (color), !NILP (background_p)))
1579 return Qt;
1580 return Qnil;
1584 /* Load color with name NAME for use by face FACE on frame F.
1585 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1586 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1587 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1588 pixel color. If color cannot be loaded, display a message, and
1589 return the foreground, background or underline color of F, but
1590 record that fact in flags of the face so that we don't try to free
1591 these colors. */
1593 unsigned long
1594 load_color (f, face, name, target_index)
1595 struct frame *f;
1596 struct face *face;
1597 Lisp_Object name;
1598 enum lface_attribute_index target_index;
1600 XColor color;
1602 xassert (STRINGP (name));
1603 xassert (target_index == LFACE_FOREGROUND_INDEX
1604 || target_index == LFACE_BACKGROUND_INDEX
1605 || target_index == LFACE_UNDERLINE_INDEX
1606 || target_index == LFACE_OVERLINE_INDEX
1607 || target_index == LFACE_STRIKE_THROUGH_INDEX
1608 || target_index == LFACE_BOX_INDEX);
1610 /* if the color map is full, defined_color will return a best match
1611 to the values in an existing cell. */
1612 if (!defined_color (f, SDATA (name), &color, 1))
1614 add_to_log ("Unable to load color \"%s\"", name, Qnil);
1616 switch (target_index)
1618 case LFACE_FOREGROUND_INDEX:
1619 face->foreground_defaulted_p = 1;
1620 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1621 break;
1623 case LFACE_BACKGROUND_INDEX:
1624 face->background_defaulted_p = 1;
1625 color.pixel = FRAME_BACKGROUND_PIXEL (f);
1626 break;
1628 case LFACE_UNDERLINE_INDEX:
1629 face->underline_defaulted_p = 1;
1630 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1631 break;
1633 case LFACE_OVERLINE_INDEX:
1634 face->overline_color_defaulted_p = 1;
1635 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1636 break;
1638 case LFACE_STRIKE_THROUGH_INDEX:
1639 face->strike_through_color_defaulted_p = 1;
1640 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1641 break;
1643 case LFACE_BOX_INDEX:
1644 face->box_color_defaulted_p = 1;
1645 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1646 break;
1648 default:
1649 abort ();
1652 #if GLYPH_DEBUG
1653 else
1654 ++ncolors_allocated;
1655 #endif
1657 return color.pixel;
1661 #ifdef HAVE_WINDOW_SYSTEM
1663 /* Load colors for face FACE which is used on frame F. Colors are
1664 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1665 of ATTRS. If the background color specified is not supported on F,
1666 try to emulate gray colors with a stipple from Vface_default_stipple. */
1668 static void
1669 load_face_colors (f, face, attrs)
1670 struct frame *f;
1671 struct face *face;
1672 Lisp_Object *attrs;
1674 Lisp_Object fg, bg;
1676 bg = attrs[LFACE_BACKGROUND_INDEX];
1677 fg = attrs[LFACE_FOREGROUND_INDEX];
1679 /* Swap colors if face is inverse-video. */
1680 if (EQ (attrs[LFACE_INVERSE_INDEX], Qt))
1682 Lisp_Object tmp;
1683 tmp = fg;
1684 fg = bg;
1685 bg = tmp;
1688 /* Check for support for foreground, not for background because
1689 face_color_supported_p is smart enough to know that grays are
1690 "supported" as background because we are supposed to use stipple
1691 for them. */
1692 if (!face_color_supported_p (f, SDATA (bg), 0)
1693 && !NILP (Fbitmap_spec_p (Vface_default_stipple)))
1695 x_destroy_bitmap (f, face->stipple);
1696 face->stipple = load_pixmap (f, Vface_default_stipple,
1697 &face->pixmap_w, &face->pixmap_h);
1700 face->background = load_color (f, face, bg, LFACE_BACKGROUND_INDEX);
1701 face->foreground = load_color (f, face, fg, LFACE_FOREGROUND_INDEX);
1705 /* Free color PIXEL on frame F. */
1707 void
1708 unload_color (f, pixel)
1709 struct frame *f;
1710 unsigned long pixel;
1712 #ifdef HAVE_X_WINDOWS
1713 if (pixel != -1)
1715 BLOCK_INPUT;
1716 x_free_colors (f, &pixel, 1);
1717 UNBLOCK_INPUT;
1719 #endif
1723 /* Free colors allocated for FACE. */
1725 static void
1726 free_face_colors (f, face)
1727 struct frame *f;
1728 struct face *face;
1730 #ifdef HAVE_X_WINDOWS
1731 if (face->colors_copied_bitwise_p)
1732 return;
1734 BLOCK_INPUT;
1736 if (!face->foreground_defaulted_p)
1738 x_free_colors (f, &face->foreground, 1);
1739 IF_DEBUG (--ncolors_allocated);
1742 if (!face->background_defaulted_p)
1744 x_free_colors (f, &face->background, 1);
1745 IF_DEBUG (--ncolors_allocated);
1748 if (face->underline_p
1749 && !face->underline_defaulted_p)
1751 x_free_colors (f, &face->underline_color, 1);
1752 IF_DEBUG (--ncolors_allocated);
1755 if (face->overline_p
1756 && !face->overline_color_defaulted_p)
1758 x_free_colors (f, &face->overline_color, 1);
1759 IF_DEBUG (--ncolors_allocated);
1762 if (face->strike_through_p
1763 && !face->strike_through_color_defaulted_p)
1765 x_free_colors (f, &face->strike_through_color, 1);
1766 IF_DEBUG (--ncolors_allocated);
1769 if (face->box != FACE_NO_BOX
1770 && !face->box_color_defaulted_p)
1772 x_free_colors (f, &face->box_color, 1);
1773 IF_DEBUG (--ncolors_allocated);
1776 UNBLOCK_INPUT;
1777 #endif /* HAVE_X_WINDOWS */
1780 #endif /* HAVE_WINDOW_SYSTEM */
1784 /***********************************************************************
1785 XLFD Font Names
1786 ***********************************************************************/
1788 /* An enumerator for each field of an XLFD font name. */
1790 enum xlfd_field
1792 XLFD_FOUNDRY,
1793 XLFD_FAMILY,
1794 XLFD_WEIGHT,
1795 XLFD_SLANT,
1796 XLFD_SWIDTH,
1797 XLFD_ADSTYLE,
1798 XLFD_PIXEL_SIZE,
1799 XLFD_POINT_SIZE,
1800 XLFD_RESX,
1801 XLFD_RESY,
1802 XLFD_SPACING,
1803 XLFD_AVGWIDTH,
1804 XLFD_REGISTRY,
1805 XLFD_ENCODING,
1806 XLFD_LAST
1809 /* An enumerator for each possible slant value of a font. Taken from
1810 the XLFD specification. */
1812 enum xlfd_slant
1814 XLFD_SLANT_UNKNOWN,
1815 XLFD_SLANT_ROMAN,
1816 XLFD_SLANT_ITALIC,
1817 XLFD_SLANT_OBLIQUE,
1818 XLFD_SLANT_REVERSE_ITALIC,
1819 XLFD_SLANT_REVERSE_OBLIQUE,
1820 XLFD_SLANT_OTHER
1823 /* Relative font weight according to XLFD documentation. */
1825 enum xlfd_weight
1827 XLFD_WEIGHT_UNKNOWN,
1828 XLFD_WEIGHT_ULTRA_LIGHT, /* 10 */
1829 XLFD_WEIGHT_EXTRA_LIGHT, /* 20 */
1830 XLFD_WEIGHT_LIGHT, /* 30 */
1831 XLFD_WEIGHT_SEMI_LIGHT, /* 40: SemiLight, Book, ... */
1832 XLFD_WEIGHT_MEDIUM, /* 50: Medium, Normal, Regular, ... */
1833 XLFD_WEIGHT_SEMI_BOLD, /* 60: SemiBold, DemiBold, ... */
1834 XLFD_WEIGHT_BOLD, /* 70: Bold, ... */
1835 XLFD_WEIGHT_EXTRA_BOLD, /* 80: ExtraBold, Heavy, ... */
1836 XLFD_WEIGHT_ULTRA_BOLD /* 90: UltraBold, Black, ... */
1839 /* Relative proportionate width. */
1841 enum xlfd_swidth
1843 XLFD_SWIDTH_UNKNOWN,
1844 XLFD_SWIDTH_ULTRA_CONDENSED, /* 10 */
1845 XLFD_SWIDTH_EXTRA_CONDENSED, /* 20 */
1846 XLFD_SWIDTH_CONDENSED, /* 30: Condensed, Narrow, Compressed, ... */
1847 XLFD_SWIDTH_SEMI_CONDENSED, /* 40: semicondensed */
1848 XLFD_SWIDTH_MEDIUM, /* 50: Medium, Normal, Regular, ... */
1849 XLFD_SWIDTH_SEMI_EXPANDED, /* 60: SemiExpanded, DemiExpanded, ... */
1850 XLFD_SWIDTH_EXPANDED, /* 70: Expanded... */
1851 XLFD_SWIDTH_EXTRA_EXPANDED, /* 80: ExtraExpanded, Wide... */
1852 XLFD_SWIDTH_ULTRA_EXPANDED /* 90: UltraExpanded... */
1855 /* Structure used for tables mapping XLFD weight, slant, and width
1856 names to numeric and symbolic values. */
1858 struct table_entry
1860 char *name;
1861 int numeric;
1862 Lisp_Object *symbol;
1865 /* Table of XLFD slant names and their numeric and symbolic
1866 representations. This table must be sorted by slant names in
1867 ascending order. */
1869 static struct table_entry slant_table[] =
1871 {"i", XLFD_SLANT_ITALIC, &Qitalic},
1872 {"o", XLFD_SLANT_OBLIQUE, &Qoblique},
1873 {"ot", XLFD_SLANT_OTHER, &Qitalic},
1874 {"r", XLFD_SLANT_ROMAN, &Qnormal},
1875 {"ri", XLFD_SLANT_REVERSE_ITALIC, &Qreverse_italic},
1876 {"ro", XLFD_SLANT_REVERSE_OBLIQUE, &Qreverse_oblique}
1879 /* Table of XLFD weight names. This table must be sorted by weight
1880 names in ascending order. */
1882 static struct table_entry weight_table[] =
1884 {"black", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold},
1885 {"bold", XLFD_WEIGHT_BOLD, &Qbold},
1886 {"book", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
1887 {"demi", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1888 {"demibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1889 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT, &Qextra_light},
1890 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
1891 {"heavy", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
1892 {"light", XLFD_WEIGHT_LIGHT, &Qlight},
1893 {"medium", XLFD_WEIGHT_MEDIUM, &Qnormal},
1894 {"normal", XLFD_WEIGHT_MEDIUM, &Qnormal},
1895 {"regular", XLFD_WEIGHT_MEDIUM, &Qnormal},
1896 {"semibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1897 {"semilight", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
1898 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT, &Qultra_light},
1899 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold}
1902 /* Table of XLFD width names. This table must be sorted by width
1903 names in ascending order. */
1905 static struct table_entry swidth_table[] =
1907 {"compressed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1908 {"condensed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1909 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
1910 {"expanded", XLFD_SWIDTH_EXPANDED, &Qexpanded},
1911 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED, &Qextra_condensed},
1912 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded},
1913 {"medium", XLFD_SWIDTH_MEDIUM, &Qnormal},
1914 {"narrow", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1915 {"normal", XLFD_SWIDTH_MEDIUM, &Qnormal},
1916 {"regular", XLFD_SWIDTH_MEDIUM, &Qnormal},
1917 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED, &Qsemi_condensed},
1918 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
1919 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED, &Qultra_condensed},
1920 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED, &Qultra_expanded},
1921 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded}
1924 /* Structure used to hold the result of splitting font names in XLFD
1925 format into their fields. */
1927 struct font_name
1929 /* The original name which is modified destructively by
1930 split_font_name. The pointer is kept here to be able to free it
1931 if it was allocated from the heap. */
1932 char *name;
1934 /* Font name fields. Each vector element points into `name' above.
1935 Fields are NUL-terminated. */
1936 char *fields[XLFD_LAST];
1938 /* Numeric values for those fields that interest us. See
1939 split_font_name for which these are. */
1940 int numeric[XLFD_LAST];
1942 /* If the original name matches one of Vface_font_rescale_alist,
1943 the value is the corresponding rescale ratio. Otherwise, the
1944 value is 1.0. */
1945 double rescale_ratio;
1947 /* Lower value mean higher priority. */
1948 int registry_priority;
1951 /* The frame in effect when sorting font names. Set temporarily in
1952 sort_fonts so that it is available in font comparison functions. */
1954 static struct frame *font_frame;
1956 /* Order by which font selection chooses fonts. The default values
1957 mean `first, find a best match for the font width, then for the
1958 font height, then for weight, then for slant.' This variable can be
1959 set via set-face-font-sort-order. */
1961 #ifdef MAC_OS
1962 static int font_sort_order[4] = {
1963 XLFD_SWIDTH, XLFD_POINT_SIZE, XLFD_WEIGHT, XLFD_SLANT
1965 #else
1966 static int font_sort_order[4];
1967 #endif
1969 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1970 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1971 is a pointer to the matching table entry or null if no table entry
1972 matches. */
1974 static struct table_entry *
1975 xlfd_lookup_field_contents (table, dim, font, field_index)
1976 struct table_entry *table;
1977 int dim;
1978 struct font_name *font;
1979 int field_index;
1981 /* Function split_font_name converts fields to lower-case, so there
1982 is no need to use xstrlwr or xstricmp here. */
1983 char *s = font->fields[field_index];
1984 int low, mid, high, cmp;
1986 low = 0;
1987 high = dim - 1;
1989 while (low <= high)
1991 mid = (low + high) / 2;
1992 cmp = strcmp (table[mid].name, s);
1994 if (cmp < 0)
1995 low = mid + 1;
1996 else if (cmp > 0)
1997 high = mid - 1;
1998 else
1999 return table + mid;
2002 return NULL;
2006 /* Return a numeric representation for font name field
2007 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2008 has DIM entries. Value is the numeric value found or DFLT if no
2009 table entry matches. This function is used to translate weight,
2010 slant, and swidth names of XLFD font names to numeric values. */
2012 static INLINE int
2013 xlfd_numeric_value (table, dim, font, field_index, dflt)
2014 struct table_entry *table;
2015 int dim;
2016 struct font_name *font;
2017 int field_index;
2018 int dflt;
2020 struct table_entry *p;
2021 p = xlfd_lookup_field_contents (table, dim, font, field_index);
2022 return p ? p->numeric : dflt;
2026 /* Return a symbolic representation for font name field
2027 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2028 has DIM entries. Value is the symbolic value found or DFLT if no
2029 table entry matches. This function is used to translate weight,
2030 slant, and swidth names of XLFD font names to symbols. */
2032 static INLINE Lisp_Object
2033 xlfd_symbolic_value (table, dim, font, field_index, dflt)
2034 struct table_entry *table;
2035 int dim;
2036 struct font_name *font;
2037 int field_index;
2038 Lisp_Object dflt;
2040 struct table_entry *p;
2041 p = xlfd_lookup_field_contents (table, dim, font, field_index);
2042 return p ? *p->symbol : dflt;
2046 /* Return a numeric value for the slant of the font given by FONT. */
2048 static INLINE int
2049 xlfd_numeric_slant (font)
2050 struct font_name *font;
2052 return xlfd_numeric_value (slant_table, DIM (slant_table),
2053 font, XLFD_SLANT, XLFD_SLANT_ROMAN);
2057 /* Return a symbol representing the weight of the font given by FONT. */
2059 static INLINE Lisp_Object
2060 xlfd_symbolic_slant (font)
2061 struct font_name *font;
2063 return xlfd_symbolic_value (slant_table, DIM (slant_table),
2064 font, XLFD_SLANT, Qnormal);
2068 /* Return a numeric value for the weight of the font given by FONT. */
2070 static INLINE int
2071 xlfd_numeric_weight (font)
2072 struct font_name *font;
2074 return xlfd_numeric_value (weight_table, DIM (weight_table),
2075 font, XLFD_WEIGHT, XLFD_WEIGHT_MEDIUM);
2079 /* Return a symbol representing the slant of the font given by FONT. */
2081 static INLINE Lisp_Object
2082 xlfd_symbolic_weight (font)
2083 struct font_name *font;
2085 return xlfd_symbolic_value (weight_table, DIM (weight_table),
2086 font, XLFD_WEIGHT, Qnormal);
2090 /* Return a numeric value for the swidth of the font whose XLFD font
2091 name fields are found in FONT. */
2093 static INLINE int
2094 xlfd_numeric_swidth (font)
2095 struct font_name *font;
2097 return xlfd_numeric_value (swidth_table, DIM (swidth_table),
2098 font, XLFD_SWIDTH, XLFD_SWIDTH_MEDIUM);
2102 /* Return a symbolic value for the swidth of FONT. */
2104 static INLINE Lisp_Object
2105 xlfd_symbolic_swidth (font)
2106 struct font_name *font;
2108 return xlfd_symbolic_value (swidth_table, DIM (swidth_table),
2109 font, XLFD_SWIDTH, Qnormal);
2113 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2114 entries. Value is a pointer to the matching table entry or null if
2115 no element of TABLE contains SYMBOL. */
2117 static struct table_entry *
2118 face_value (table, dim, symbol)
2119 struct table_entry *table;
2120 int dim;
2121 Lisp_Object symbol;
2123 int i;
2125 xassert (SYMBOLP (symbol));
2127 for (i = 0; i < dim; ++i)
2128 if (EQ (*table[i].symbol, symbol))
2129 break;
2131 return i < dim ? table + i : NULL;
2135 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2136 entries. Value is -1 if SYMBOL is not found in TABLE. */
2138 static INLINE int
2139 face_numeric_value (table, dim, symbol)
2140 struct table_entry *table;
2141 int dim;
2142 Lisp_Object symbol;
2144 struct table_entry *p = face_value (table, dim, symbol);
2145 return p ? p->numeric : -1;
2149 /* Return a numeric value representing the weight specified by Lisp
2150 symbol WEIGHT. Value is one of the enumerators of enum
2151 xlfd_weight. */
2153 static INLINE int
2154 face_numeric_weight (weight)
2155 Lisp_Object weight;
2157 return face_numeric_value (weight_table, DIM (weight_table), weight);
2161 /* Return a numeric value representing the slant specified by Lisp
2162 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2164 static INLINE int
2165 face_numeric_slant (slant)
2166 Lisp_Object slant;
2168 return face_numeric_value (slant_table, DIM (slant_table), slant);
2172 /* Return a numeric value representing the swidth specified by Lisp
2173 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2175 static int
2176 face_numeric_swidth (width)
2177 Lisp_Object width;
2179 return face_numeric_value (swidth_table, DIM (swidth_table), width);
2183 #ifdef HAVE_WINDOW_SYSTEM
2185 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2187 static INLINE int
2188 xlfd_fixed_p (font)
2189 struct font_name *font;
2191 /* Function split_font_name converts fields to lower-case, so there
2192 is no need to use tolower here. */
2193 return *font->fields[XLFD_SPACING] != 'p';
2197 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2199 The actual height of the font when displayed on F depends on the
2200 resolution of both the font and frame. For example, a 10pt font
2201 designed for a 100dpi display will display larger than 10pt on a
2202 75dpi display. (It's not unusual to use fonts not designed for the
2203 display one is using. For example, some intlfonts are available in
2204 72dpi versions, only.)
2206 Value is the real point size of FONT on frame F, or 0 if it cannot
2207 be determined. */
2209 static INLINE int
2210 xlfd_point_size (f, font)
2211 struct frame *f;
2212 struct font_name *font;
2214 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
2215 char *pixel_field = font->fields[XLFD_PIXEL_SIZE];
2216 double pixel;
2217 int real_pt;
2219 if (*pixel_field == '[')
2221 /* The pixel size field is `[A B C D]' which specifies
2222 a transformation matrix.
2224 A B 0
2225 C D 0
2226 0 0 1
2228 by which all glyphs of the font are transformed. The spec
2229 says that s scalar value N for the pixel size is equivalent
2230 to A = N * resx/resy, B = C = 0, D = N. */
2231 char *start = pixel_field + 1, *end;
2232 double matrix[4];
2233 int i;
2235 for (i = 0; i < 4; ++i)
2237 matrix[i] = strtod (start, &end);
2238 start = end;
2241 pixel = matrix[3];
2243 else
2244 pixel = atoi (pixel_field);
2246 if (pixel == 0)
2247 real_pt = 0;
2248 else
2249 real_pt = PT_PER_INCH * 10.0 * pixel / resy + 0.5;
2251 return real_pt;
2255 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2256 of frame F. This function is used to guess a point size of font
2257 when only the pixel height of the font is available. */
2259 static INLINE int
2260 pixel_point_size (f, pixel)
2261 struct frame *f;
2262 int pixel;
2264 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
2265 double real_pt;
2266 int int_pt;
2268 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2269 point size of one dot. */
2270 real_pt = pixel * PT_PER_INCH / resy;
2271 int_pt = real_pt + 0.5;
2273 return int_pt;
2277 /* Return a rescaling ratio of a font of NAME. */
2279 static double
2280 font_rescale_ratio (char *name)
2282 Lisp_Object tail, elt;
2284 for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
2286 elt = XCAR (tail);
2287 if (STRINGP (XCAR (elt)) && FLOATP (XCDR (elt))
2288 && fast_c_string_match_ignore_case (XCAR (elt), name) >= 0)
2289 return XFLOAT_DATA (XCDR (elt));
2291 return 1.0;
2295 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2296 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2297 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2298 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2299 zero if the font name doesn't have the format we expect. The
2300 expected format is a font name that starts with a `-' and has
2301 XLFD_LAST fields separated by `-'. */
2303 static int
2304 split_font_name (f, font, numeric_p)
2305 struct frame *f;
2306 struct font_name *font;
2307 int numeric_p;
2309 int i = 0;
2310 int success_p;
2311 double rescale_ratio;
2313 if (numeric_p)
2314 /* This must be done before splitting the font name. */
2315 rescale_ratio = font_rescale_ratio (font->name);
2317 if (*font->name == '-')
2319 char *p = xstrlwr (font->name) + 1;
2321 while (i < XLFD_LAST)
2323 font->fields[i] = p;
2324 ++i;
2326 /* Pixel and point size may be of the form `[....]'. For
2327 BNF, see XLFD spec, chapter 4. Negative values are
2328 indicated by tilde characters which we replace with
2329 `-' characters, here. */
2330 if (*p == '['
2331 && (i - 1 == XLFD_PIXEL_SIZE
2332 || i - 1 == XLFD_POINT_SIZE))
2334 char *start, *end;
2335 int j;
2337 for (++p; *p && *p != ']'; ++p)
2338 if (*p == '~')
2339 *p = '-';
2341 /* Check that the matrix contains 4 floating point
2342 numbers. */
2343 for (j = 0, start = font->fields[i - 1] + 1;
2344 j < 4;
2345 ++j, start = end)
2346 if (strtod (start, &end) == 0 && start == end)
2347 break;
2349 if (j < 4)
2350 break;
2353 while (*p && *p != '-')
2354 ++p;
2356 if (*p != '-')
2357 break;
2359 *p++ = 0;
2363 success_p = i == XLFD_LAST;
2365 /* If requested, and font name was in the expected format,
2366 compute numeric values for some fields. */
2367 if (numeric_p && success_p)
2369 font->numeric[XLFD_POINT_SIZE] = xlfd_point_size (f, font);
2370 font->numeric[XLFD_RESY] = atoi (font->fields[XLFD_RESY]);
2371 font->numeric[XLFD_SLANT] = xlfd_numeric_slant (font);
2372 font->numeric[XLFD_WEIGHT] = xlfd_numeric_weight (font);
2373 font->numeric[XLFD_SWIDTH] = xlfd_numeric_swidth (font);
2374 font->numeric[XLFD_AVGWIDTH] = atoi (font->fields[XLFD_AVGWIDTH]);
2375 font->rescale_ratio = rescale_ratio;
2378 /* Initialize it to zero. It will be overridden by font_list while
2379 trying alternate registries. */
2380 font->registry_priority = 0;
2382 return success_p;
2386 /* Build an XLFD font name from font name fields in FONT. Value is a
2387 pointer to the font name, which is allocated via xmalloc. */
2389 static char *
2390 build_font_name (font)
2391 struct font_name *font;
2393 int i;
2394 int size = 100;
2395 char *font_name = (char *) xmalloc (size);
2396 int total_length = 0;
2398 for (i = 0; i < XLFD_LAST; ++i)
2400 /* Add 1 because of the leading `-'. */
2401 int len = strlen (font->fields[i]) + 1;
2403 /* Reallocate font_name if necessary. Add 1 for the final
2404 NUL-byte. */
2405 if (total_length + len + 1 >= size)
2407 int new_size = max (2 * size, size + len + 1);
2408 int sz = new_size * sizeof *font_name;
2409 font_name = (char *) xrealloc (font_name, sz);
2410 size = new_size;
2413 font_name[total_length] = '-';
2414 bcopy (font->fields[i], font_name + total_length + 1, len - 1);
2415 total_length += len;
2418 font_name[total_length] = 0;
2419 return font_name;
2423 /* Free an array FONTS of N font_name structures. This frees FONTS
2424 itself and all `name' fields in its elements. */
2426 static INLINE void
2427 free_font_names (fonts, n)
2428 struct font_name *fonts;
2429 int n;
2431 while (n)
2432 xfree (fonts[--n].name);
2433 xfree (fonts);
2437 /* Sort vector FONTS of font_name structures which contains NFONTS
2438 elements using qsort and comparison function CMPFN. F is the frame
2439 on which the fonts will be used. The global variable font_frame
2440 is temporarily set to F to make it available in CMPFN. */
2442 static INLINE void
2443 sort_fonts (f, fonts, nfonts, cmpfn)
2444 struct frame *f;
2445 struct font_name *fonts;
2446 int nfonts;
2447 int (*cmpfn) P_ ((const void *, const void *));
2449 font_frame = f;
2450 qsort (fonts, nfonts, sizeof *fonts, cmpfn);
2451 font_frame = NULL;
2455 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2456 display in x_display_list. FONTS is a pointer to a vector of
2457 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2458 alternative patterns from Valternate_fontname_alist if no fonts are
2459 found matching PATTERN.
2461 For all fonts found, set FONTS[i].name to the name of the font,
2462 allocated via xmalloc, and split font names into fields. Ignore
2463 fonts that we can't parse. Value is the number of fonts found. */
2465 static int
2466 x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p)
2467 struct frame *f;
2468 char *pattern;
2469 struct font_name **pfonts;
2470 int nfonts, try_alternatives_p;
2472 int n, nignored;
2474 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2475 better to do it the other way around. */
2476 Lisp_Object lfonts;
2477 Lisp_Object lpattern, tem;
2478 struct font_name *fonts = 0;
2479 int num_fonts = nfonts;
2481 *pfonts = 0;
2482 lpattern = build_string (pattern);
2484 /* Get the list of fonts matching PATTERN. */
2485 #ifdef WINDOWSNT
2486 BLOCK_INPUT;
2487 lfonts = w32_list_fonts (f, lpattern, 0, nfonts);
2488 UNBLOCK_INPUT;
2489 #else
2490 lfonts = x_list_fonts (f, lpattern, -1, nfonts);
2491 #endif
2493 if (nfonts < 0 && CONSP (lfonts))
2494 num_fonts = XFASTINT (Flength (lfonts));
2496 /* Make a copy of the font names we got from X, and
2497 split them into fields. */
2498 n = nignored = 0;
2499 for (tem = lfonts; CONSP (tem) && n < num_fonts; tem = XCDR (tem))
2501 Lisp_Object elt, tail;
2502 const char *name = SDATA (XCAR (tem));
2504 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2505 for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail))
2507 elt = XCAR (tail);
2508 if (STRINGP (elt)
2509 && fast_c_string_match_ignore_case (elt, name) >= 0)
2510 break;
2512 if (!NILP (tail))
2514 ++nignored;
2515 continue;
2518 if (! fonts)
2520 *pfonts = (struct font_name *) xmalloc (num_fonts * sizeof **pfonts);
2521 fonts = *pfonts;
2524 /* Make a copy of the font name. */
2525 fonts[n].name = xstrdup (name);
2527 if (split_font_name (f, fonts + n, 1))
2529 if (font_scalable_p (fonts + n)
2530 && !may_use_scalable_font_p (name))
2532 ++nignored;
2533 xfree (fonts[n].name);
2535 else
2536 ++n;
2538 else
2539 xfree (fonts[n].name);
2542 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2543 if (n == 0 && try_alternatives_p)
2545 Lisp_Object list = Valternate_fontname_alist;
2547 if (*pfonts)
2549 xfree (*pfonts);
2550 *pfonts = 0;
2553 while (CONSP (list))
2555 Lisp_Object entry = XCAR (list);
2556 if (CONSP (entry)
2557 && STRINGP (XCAR (entry))
2558 && strcmp (SDATA (XCAR (entry)), pattern) == 0)
2559 break;
2560 list = XCDR (list);
2563 if (CONSP (list))
2565 Lisp_Object patterns = XCAR (list);
2566 Lisp_Object name;
2568 while (CONSP (patterns)
2569 /* If list is screwed up, give up. */
2570 && (name = XCAR (patterns),
2571 STRINGP (name))
2572 /* Ignore patterns equal to PATTERN because we tried that
2573 already with no success. */
2574 && (strcmp (SDATA (name), pattern) == 0
2575 || (n = x_face_list_fonts (f, SDATA (name),
2576 pfonts, nfonts, 0),
2577 n == 0)))
2578 patterns = XCDR (patterns);
2582 return n;
2586 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2587 using comparison function CMPFN. Value is the number of fonts
2588 found. If value is non-zero, *FONTS is set to a vector of
2589 font_name structures allocated from the heap containing matching
2590 fonts. Each element of *FONTS contains a name member that is also
2591 allocated from the heap. Font names in these structures are split
2592 into fields. Use free_font_names to free such an array. */
2594 static int
2595 sorted_font_list (f, pattern, cmpfn, fonts)
2596 struct frame *f;
2597 char *pattern;
2598 int (*cmpfn) P_ ((const void *, const void *));
2599 struct font_name **fonts;
2601 int nfonts;
2603 /* Get the list of fonts matching pattern. 100 should suffice. */
2604 nfonts = DEFAULT_FONT_LIST_LIMIT;
2605 if (INTEGERP (Vfont_list_limit))
2606 nfonts = XINT (Vfont_list_limit);
2608 *fonts = NULL;
2609 nfonts = x_face_list_fonts (f, pattern, fonts, nfonts, 1);
2611 /* Sort the resulting array and return it in *FONTS. If no
2612 fonts were found, make sure to set *FONTS to null. */
2613 if (nfonts)
2614 sort_fonts (f, *fonts, nfonts, cmpfn);
2615 else if (*fonts)
2617 xfree (*fonts);
2618 *fonts = NULL;
2621 return nfonts;
2625 /* Compare two font_name structures *A and *B. Value is analogous to
2626 strcmp. Sort order is given by the global variable
2627 font_sort_order. Font names are sorted so that, everything else
2628 being equal, fonts with a resolution closer to that of the frame on
2629 which they are used are listed first. The global variable
2630 font_frame is the frame on which we operate. */
2632 static int
2633 cmp_font_names (a, b)
2634 const void *a, *b;
2636 struct font_name *x = (struct font_name *) a;
2637 struct font_name *y = (struct font_name *) b;
2638 int cmp;
2640 /* All strings have been converted to lower-case by split_font_name,
2641 so we can use strcmp here. */
2642 cmp = strcmp (x->fields[XLFD_FAMILY], y->fields[XLFD_FAMILY]);
2643 if (cmp == 0)
2645 int i;
2647 for (i = 0; i < DIM (font_sort_order) && cmp == 0; ++i)
2649 int j = font_sort_order[i];
2650 cmp = x->numeric[j] - y->numeric[j];
2653 if (cmp == 0)
2655 /* Everything else being equal, we prefer fonts with an
2656 y-resolution closer to that of the frame. */
2657 int resy = FRAME_X_DISPLAY_INFO (font_frame)->resy;
2658 int x_resy = x->numeric[XLFD_RESY];
2659 int y_resy = y->numeric[XLFD_RESY];
2660 cmp = abs (resy - x_resy) - abs (resy - y_resy);
2664 return cmp;
2668 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2669 is non-nil list fonts matching that pattern. Otherwise, if
2670 REGISTRY is non-nil return only fonts with that registry, otherwise
2671 return fonts of any registry. Set *FONTS to a vector of font_name
2672 structures allocated from the heap containing the fonts found.
2673 Value is the number of fonts found. */
2675 static int
2676 font_list_1 (f, pattern, family, registry, fonts)
2677 struct frame *f;
2678 Lisp_Object pattern, family, registry;
2679 struct font_name **fonts;
2681 char *pattern_str, *family_str, *registry_str;
2683 if (NILP (pattern))
2685 family_str = (NILP (family) ? "*" : (char *) SDATA (family));
2686 registry_str = (NILP (registry) ? "*" : (char *) SDATA (registry));
2688 pattern_str = (char *) alloca (strlen (family_str)
2689 + strlen (registry_str)
2690 + 10);
2691 strcpy (pattern_str, index (family_str, '-') ? "-" : "-*-");
2692 strcat (pattern_str, family_str);
2693 strcat (pattern_str, "-*-");
2694 strcat (pattern_str, registry_str);
2695 if (!index (registry_str, '-'))
2697 if (registry_str[strlen (registry_str) - 1] == '*')
2698 strcat (pattern_str, "-*");
2699 else
2700 strcat (pattern_str, "*-*");
2703 else
2704 pattern_str = (char *) SDATA (pattern);
2706 return sorted_font_list (f, pattern_str, cmp_font_names, fonts);
2710 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2711 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2712 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2713 freed. */
2715 static struct font_name *
2716 concat_font_list (fonts1, nfonts1, fonts2, nfonts2)
2717 struct font_name *fonts1, *fonts2;
2718 int nfonts1, nfonts2;
2720 int new_nfonts = nfonts1 + nfonts2;
2721 struct font_name *new_fonts;
2723 new_fonts = (struct font_name *) xmalloc (sizeof *new_fonts * new_nfonts);
2724 bcopy (fonts1, new_fonts, sizeof *new_fonts * nfonts1);
2725 bcopy (fonts2, new_fonts + nfonts1, sizeof *new_fonts * nfonts2);
2726 xfree (fonts1);
2727 xfree (fonts2);
2728 return new_fonts;
2732 /* Get a sorted list of fonts of family FAMILY on frame F.
2734 If PATTERN is non-nil list fonts matching that pattern.
2736 If REGISTRY is non-nil, return fonts with that registry and the
2737 alternative registries from Vface_alternative_font_registry_alist.
2739 If REGISTRY is nil return fonts of any registry.
2741 Set *FONTS to a vector of font_name structures allocated from the
2742 heap containing the fonts found. Value is the number of fonts
2743 found. */
2745 static int
2746 font_list (f, pattern, family, registry, fonts)
2747 struct frame *f;
2748 Lisp_Object pattern, family, registry;
2749 struct font_name **fonts;
2751 int nfonts = font_list_1 (f, pattern, family, registry, fonts);
2753 if (!NILP (registry)
2754 && CONSP (Vface_alternative_font_registry_alist))
2756 Lisp_Object alter;
2758 alter = Fassoc (registry, Vface_alternative_font_registry_alist);
2759 if (CONSP (alter))
2761 int reg_prio, i;
2763 for (alter = XCDR (alter), reg_prio = 1;
2764 CONSP (alter);
2765 alter = XCDR (alter), reg_prio++)
2766 if (STRINGP (XCAR (alter)))
2768 int nfonts2;
2769 struct font_name *fonts2;
2771 nfonts2 = font_list_1 (f, pattern, family, XCAR (alter),
2772 &fonts2);
2773 for (i = 0; i < nfonts2; i++)
2774 fonts2[i].registry_priority = reg_prio;
2775 *fonts = (nfonts > 0
2776 ? concat_font_list (*fonts, nfonts, fonts2, nfonts2)
2777 : fonts2);
2778 nfonts += nfonts2;
2783 return nfonts;
2787 /* Remove elements from LIST whose cars are `equal'. Called from
2788 x-family-fonts and x-font-family-list to remove duplicate font
2789 entries. */
2791 static void
2792 remove_duplicates (list)
2793 Lisp_Object list;
2795 Lisp_Object tail = list;
2797 while (!NILP (tail) && !NILP (XCDR (tail)))
2799 Lisp_Object next = XCDR (tail);
2800 if (!NILP (Fequal (XCAR (next), XCAR (tail))))
2801 XSETCDR (tail, XCDR (next));
2802 else
2803 tail = XCDR (tail);
2808 DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
2809 doc: /* Return a list of available fonts of family FAMILY on FRAME.
2810 If FAMILY is omitted or nil, list all families.
2811 Otherwise, FAMILY must be a string, possibly containing wildcards
2812 `?' and `*'.
2813 If FRAME is omitted or nil, use the selected frame.
2814 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2815 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2816 FAMILY is the font family name. POINT-SIZE is the size of the
2817 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2818 width, weight and slant of the font. These symbols are the same as for
2819 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2820 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2821 giving the registry and encoding of the font.
2822 The result list is sorted according to the current setting of
2823 the face font sort order. */)
2824 (family, frame)
2825 Lisp_Object family, frame;
2827 struct frame *f = check_x_frame (frame);
2828 struct font_name *fonts;
2829 int i, nfonts;
2830 Lisp_Object result;
2831 struct gcpro gcpro1;
2833 if (!NILP (family))
2834 CHECK_STRING (family);
2836 result = Qnil;
2837 GCPRO1 (result);
2838 nfonts = font_list (f, Qnil, family, Qnil, &fonts);
2839 for (i = nfonts - 1; i >= 0; --i)
2841 Lisp_Object v = Fmake_vector (make_number (8), Qnil);
2842 char *tem;
2844 ASET (v, 0, build_string (fonts[i].fields[XLFD_FAMILY]));
2845 ASET (v, 1, xlfd_symbolic_swidth (fonts + i));
2846 ASET (v, 2, make_number (xlfd_point_size (f, fonts + i)));
2847 ASET (v, 3, xlfd_symbolic_weight (fonts + i));
2848 ASET (v, 4, xlfd_symbolic_slant (fonts + i));
2849 ASET (v, 5, xlfd_fixed_p (fonts + i) ? Qt : Qnil);
2850 tem = build_font_name (fonts + i);
2851 ASET (v, 6, build_string (tem));
2852 sprintf (tem, "%s-%s", fonts[i].fields[XLFD_REGISTRY],
2853 fonts[i].fields[XLFD_ENCODING]);
2854 ASET (v, 7, build_string (tem));
2855 xfree (tem);
2857 result = Fcons (v, result);
2860 remove_duplicates (result);
2861 free_font_names (fonts, nfonts);
2862 UNGCPRO;
2863 return result;
2867 DEFUN ("x-font-family-list", Fx_font_family_list, Sx_font_family_list,
2868 0, 1, 0,
2869 doc: /* Return a list of available font families on FRAME.
2870 If FRAME is omitted or nil, use the selected frame.
2871 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2872 is a font family, and FIXED-P is non-nil if fonts of that family
2873 are fixed-pitch. */)
2874 (frame)
2875 Lisp_Object frame;
2877 struct frame *f = check_x_frame (frame);
2878 int nfonts, i;
2879 struct font_name *fonts;
2880 Lisp_Object result;
2881 struct gcpro gcpro1;
2882 int count = SPECPDL_INDEX ();
2884 /* Let's consider all fonts. */
2885 specbind (intern ("font-list-limit"), make_number (-1));
2886 nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
2888 result = Qnil;
2889 GCPRO1 (result);
2890 for (i = nfonts - 1; i >= 0; --i)
2891 result = Fcons (Fcons (build_string (fonts[i].fields[XLFD_FAMILY]),
2892 xlfd_fixed_p (fonts + i) ? Qt : Qnil),
2893 result);
2895 remove_duplicates (result);
2896 free_font_names (fonts, nfonts);
2897 UNGCPRO;
2898 return unbind_to (count, result);
2902 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
2903 doc: /* Return a list of the names of available fonts matching PATTERN.
2904 If optional arguments FACE and FRAME are specified, return only fonts
2905 the same size as FACE on FRAME.
2906 PATTERN is a string, perhaps with wildcard characters;
2907 the * character matches any substring, and
2908 the ? character matches any single character.
2909 PATTERN is case-insensitive.
2910 FACE is a face name--a symbol.
2912 The return value is a list of strings, suitable as arguments to
2913 set-face-font.
2915 Fonts Emacs can't use may or may not be excluded
2916 even if they match PATTERN and FACE.
2917 The optional fourth argument MAXIMUM sets a limit on how many
2918 fonts to match. The first MAXIMUM fonts are reported.
2919 The optional fifth argument WIDTH, if specified, is a number of columns
2920 occupied by a character of a font. In that case, return only fonts
2921 the WIDTH times as wide as FACE on FRAME. */)
2922 (pattern, face, frame, maximum, width)
2923 Lisp_Object pattern, face, frame, maximum, width;
2925 struct frame *f;
2926 int size;
2927 int maxnames;
2929 check_x ();
2930 CHECK_STRING (pattern);
2932 if (NILP (maximum))
2933 maxnames = -1;
2934 else
2936 CHECK_NATNUM (maximum);
2937 maxnames = XINT (maximum);
2940 if (!NILP (width))
2941 CHECK_NUMBER (width);
2943 /* We can't simply call check_x_frame because this function may be
2944 called before any frame is created. */
2945 f = frame_or_selected_frame (frame, 2);
2946 if (!FRAME_WINDOW_P (f))
2948 /* Perhaps we have not yet created any frame. */
2949 f = NULL;
2950 face = Qnil;
2953 /* Determine the width standard for comparison with the fonts we find. */
2955 if (NILP (face))
2956 size = 0;
2957 else
2959 /* This is of limited utility since it works with character
2960 widths. Keep it for compatibility. --gerd. */
2961 int face_id = lookup_named_face (f, face, 0);
2962 struct face *face = (face_id < 0
2963 ? NULL
2964 : FACE_FROM_ID (f, face_id));
2966 if (face && face->font)
2967 size = FONT_WIDTH (face->font);
2968 else
2969 size = FONT_WIDTH (FRAME_FONT (f));
2971 if (!NILP (width))
2972 size *= XINT (width);
2976 Lisp_Object args[2];
2978 args[0] = x_list_fonts (f, pattern, size, maxnames);
2979 if (f == NULL)
2980 /* We don't have to check fontsets. */
2981 return args[0];
2982 args[1] = list_fontsets (f, pattern, size);
2983 return Fnconc (2, args);
2987 #endif /* HAVE_WINDOW_SYSTEM */
2991 /***********************************************************************
2992 Lisp Faces
2993 ***********************************************************************/
2995 /* Access face attributes of face LFACE, a Lisp vector. */
2997 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2998 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2999 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3000 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3001 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3002 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3003 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3004 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3005 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3006 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3007 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3008 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3009 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3010 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3011 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3012 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3014 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3015 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3017 #define LFACEP(LFACE) \
3018 (VECTORP (LFACE) \
3019 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3020 && EQ (AREF (LFACE, 0), Qface))
3023 #if GLYPH_DEBUG
3025 /* Check consistency of Lisp face attribute vector ATTRS. */
3027 static void
3028 check_lface_attrs (attrs)
3029 Lisp_Object *attrs;
3031 xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
3032 || STRINGP (attrs[LFACE_FAMILY_INDEX]));
3033 xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
3034 || SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
3035 xassert (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])
3036 || INTEGERP (attrs[LFACE_AVGWIDTH_INDEX]));
3037 xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
3038 || INTEGERP (attrs[LFACE_HEIGHT_INDEX])
3039 || FLOATP (attrs[LFACE_HEIGHT_INDEX])
3040 || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX]));
3041 xassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
3042 || SYMBOLP (attrs[LFACE_WEIGHT_INDEX]));
3043 xassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
3044 || SYMBOLP (attrs[LFACE_SLANT_INDEX]));
3045 xassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
3046 || SYMBOLP (attrs[LFACE_UNDERLINE_INDEX])
3047 || STRINGP (attrs[LFACE_UNDERLINE_INDEX]));
3048 xassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
3049 || SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
3050 || STRINGP (attrs[LFACE_OVERLINE_INDEX]));
3051 xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
3052 || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
3053 || STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX]));
3054 xassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
3055 || SYMBOLP (attrs[LFACE_BOX_INDEX])
3056 || STRINGP (attrs[LFACE_BOX_INDEX])
3057 || INTEGERP (attrs[LFACE_BOX_INDEX])
3058 || CONSP (attrs[LFACE_BOX_INDEX]));
3059 xassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
3060 || SYMBOLP (attrs[LFACE_INVERSE_INDEX]));
3061 xassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
3062 || STRINGP (attrs[LFACE_FOREGROUND_INDEX]));
3063 xassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
3064 || STRINGP (attrs[LFACE_BACKGROUND_INDEX]));
3065 xassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
3066 || NILP (attrs[LFACE_INHERIT_INDEX])
3067 || SYMBOLP (attrs[LFACE_INHERIT_INDEX])
3068 || CONSP (attrs[LFACE_INHERIT_INDEX]));
3069 #ifdef HAVE_WINDOW_SYSTEM
3070 xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
3071 || SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
3072 || !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
3073 xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
3074 || NILP (attrs[LFACE_FONT_INDEX])
3075 || STRINGP (attrs[LFACE_FONT_INDEX]));
3076 #endif
3080 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3082 static void
3083 check_lface (lface)
3084 Lisp_Object lface;
3086 if (!NILP (lface))
3088 xassert (LFACEP (lface));
3089 check_lface_attrs (XVECTOR (lface)->contents);
3093 #else /* GLYPH_DEBUG == 0 */
3095 #define check_lface_attrs(attrs) (void) 0
3096 #define check_lface(lface) (void) 0
3098 #endif /* GLYPH_DEBUG == 0 */
3101 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3102 to make it a symvol. If FACE_NAME is an alias for another face,
3103 return that face's name. */
3105 static Lisp_Object
3106 resolve_face_name (face_name)
3107 Lisp_Object face_name;
3109 Lisp_Object aliased;
3111 if (STRINGP (face_name))
3112 face_name = intern (SDATA (face_name));
3114 while (SYMBOLP (face_name))
3116 aliased = Fget (face_name, Qface_alias);
3117 if (NILP (aliased))
3118 break;
3119 else
3120 face_name = aliased;
3123 return face_name;
3127 /* Return the face definition of FACE_NAME on frame F. F null means
3128 return the definition for new frames. FACE_NAME may be a string or
3129 a symbol (apparently Emacs 20.2 allowed strings as face names in
3130 face text properties; Ediff uses that). If FACE_NAME is an alias
3131 for another face, return that face's definition. If SIGNAL_P is
3132 non-zero, signal an error if FACE_NAME is not a valid face name.
3133 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3134 name. */
3136 static INLINE Lisp_Object
3137 lface_from_face_name (f, face_name, signal_p)
3138 struct frame *f;
3139 Lisp_Object face_name;
3140 int signal_p;
3142 Lisp_Object lface;
3144 face_name = resolve_face_name (face_name);
3146 if (f)
3147 lface = assq_no_quit (face_name, f->face_alist);
3148 else
3149 lface = assq_no_quit (face_name, Vface_new_frame_defaults);
3151 if (CONSP (lface))
3152 lface = XCDR (lface);
3153 else if (signal_p)
3154 signal_error ("Invalid face", face_name);
3156 check_lface (lface);
3157 return lface;
3161 /* Get face attributes of face FACE_NAME from frame-local faces on
3162 frame F. Store the resulting attributes in ATTRS which must point
3163 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3164 is non-zero, signal an error if FACE_NAME does not name a face.
3165 Otherwise, value is zero if FACE_NAME is not a face. */
3167 static INLINE int
3168 get_lface_attributes (f, face_name, attrs, signal_p)
3169 struct frame *f;
3170 Lisp_Object face_name;
3171 Lisp_Object *attrs;
3172 int signal_p;
3174 Lisp_Object lface;
3175 int success_p;
3177 lface = lface_from_face_name (f, face_name, signal_p);
3178 if (!NILP (lface))
3180 bcopy (XVECTOR (lface)->contents, attrs,
3181 LFACE_VECTOR_SIZE * sizeof *attrs);
3182 success_p = 1;
3184 else
3185 success_p = 0;
3187 return success_p;
3191 /* Non-zero if all attributes in face attribute vector ATTRS are
3192 specified, i.e. are non-nil. */
3194 static int
3195 lface_fully_specified_p (attrs)
3196 Lisp_Object *attrs;
3198 int i;
3200 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3201 if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
3202 && i != LFACE_AVGWIDTH_INDEX)
3203 if (UNSPECIFIEDP (attrs[i]))
3204 break;
3206 return i == LFACE_VECTOR_SIZE;
3209 #ifdef HAVE_WINDOW_SYSTEM
3211 /* Set font-related attributes of Lisp face LFACE from the fullname of
3212 the font opened by FONTNAME. If FORCE_P is zero, set only
3213 unspecified attributes of LFACE. The exception is `font'
3214 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3216 If FONTNAME is not available on frame F,
3217 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3218 If the fullname is not in a valid XLFD format,
3219 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3220 in LFACE and return 1.
3221 Otherwise, return 1. */
3223 static int
3224 set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p)
3225 struct frame *f;
3226 Lisp_Object lface;
3227 Lisp_Object fontname;
3228 int force_p, may_fail_p;
3230 struct font_name font;
3231 char *buffer;
3232 int pt;
3233 int have_xlfd_p;
3234 int fontset;
3235 char *font_name = SDATA (fontname);
3236 struct font_info *font_info;
3238 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3239 fontset = fs_query_fontset (fontname, 0);
3240 if (fontset >= 0)
3241 font_name = SDATA (fontset_ascii (fontset));
3243 /* Check if FONT_NAME is surely available on the system. Usually
3244 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3245 returns quickly. But, even if FONT_NAME is not yet cached,
3246 caching it now is not futail because we anyway load the font
3247 later. */
3248 BLOCK_INPUT;
3249 font_info = FS_LOAD_FONT (f, 0, font_name, -1);
3250 UNBLOCK_INPUT;
3252 if (!font_info)
3254 if (may_fail_p)
3255 return 0;
3256 abort ();
3259 font.name = STRDUPA (font_info->full_name);
3260 have_xlfd_p = split_font_name (f, &font, 1);
3262 /* Set attributes only if unspecified, otherwise face defaults for
3263 new frames would never take effect. If we couldn't get a font
3264 name conforming to XLFD, set normal values. */
3266 if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
3268 Lisp_Object val;
3269 if (have_xlfd_p)
3271 buffer = (char *) alloca (strlen (font.fields[XLFD_FAMILY])
3272 + strlen (font.fields[XLFD_FOUNDRY])
3273 + 2);
3274 sprintf (buffer, "%s-%s", font.fields[XLFD_FOUNDRY],
3275 font.fields[XLFD_FAMILY]);
3276 val = build_string (buffer);
3278 else
3279 val = build_string ("*");
3280 LFACE_FAMILY (lface) = val;
3283 if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
3285 if (have_xlfd_p)
3286 pt = xlfd_point_size (f, &font);
3287 else
3288 pt = pixel_point_size (f, font_info->height * 10);
3289 xassert (pt > 0);
3290 LFACE_HEIGHT (lface) = make_number (pt);
3293 if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
3294 LFACE_SWIDTH (lface)
3295 = have_xlfd_p ? xlfd_symbolic_swidth (&font) : Qnormal;
3297 if (force_p || UNSPECIFIEDP (LFACE_AVGWIDTH (lface)))
3298 LFACE_AVGWIDTH (lface)
3299 = (have_xlfd_p
3300 ? make_number (font.numeric[XLFD_AVGWIDTH])
3301 : Qunspecified);
3303 if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
3304 LFACE_WEIGHT (lface)
3305 = have_xlfd_p ? xlfd_symbolic_weight (&font) : Qnormal;
3307 if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
3308 LFACE_SLANT (lface)
3309 = have_xlfd_p ? xlfd_symbolic_slant (&font) : Qnormal;
3311 LFACE_FONT (lface) = fontname;
3313 return 1;
3316 #endif /* HAVE_WINDOW_SYSTEM */
3319 /* Merges the face height FROM with the face height TO, and returns the
3320 merged height. If FROM is an invalid height, then INVALID is
3321 returned instead. FROM and TO may be either absolute face heights or
3322 `relative' heights; the returned value is always an absolute height
3323 unless both FROM and TO are relative. GCPRO is a lisp value that
3324 will be protected from garbage-collection if this function makes a
3325 call into lisp. */
3327 Lisp_Object
3328 merge_face_heights (from, to, invalid, gcpro)
3329 Lisp_Object from, to, invalid, gcpro;
3331 Lisp_Object result = invalid;
3333 if (INTEGERP (from))
3334 /* FROM is absolute, just use it as is. */
3335 result = from;
3336 else if (FLOATP (from))
3337 /* FROM is a scale, use it to adjust TO. */
3339 if (INTEGERP (to))
3340 /* relative X absolute => absolute */
3341 result = make_number ((EMACS_INT)(XFLOAT_DATA (from) * XINT (to)));
3342 else if (FLOATP (to))
3343 /* relative X relative => relative */
3344 result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
3346 else if (FUNCTIONP (from))
3347 /* FROM is a function, which use to adjust TO. */
3349 /* Call function with current height as argument.
3350 From is the new height. */
3351 Lisp_Object args[2];
3352 struct gcpro gcpro1;
3354 GCPRO1 (gcpro);
3356 args[0] = from;
3357 args[1] = to;
3358 result = safe_call (2, args);
3360 UNGCPRO;
3362 /* Ensure that if TO was absolute, so is the result. */
3363 if (INTEGERP (to) && !INTEGERP (result))
3364 result = invalid;
3367 return result;
3371 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3372 store the resulting attributes in TO, which must be already be
3373 completely specified and contain only absolute attributes. Every
3374 specified attribute of FROM overrides the corresponding attribute of
3375 TO; relative attributes in FROM are merged with the absolute value in
3376 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3377 face inheritance; it should be Qnil when called from other places. */
3379 static INLINE void
3380 merge_face_vectors (f, from, to, cycle_check)
3381 struct frame *f;
3382 Lisp_Object *from, *to;
3383 Lisp_Object cycle_check;
3385 int i;
3387 /* If FROM inherits from some other faces, merge their attributes into
3388 TO before merging FROM's direct attributes. Note that an :inherit
3389 attribute of `unspecified' is the same as one of nil; we never
3390 merge :inherit attributes, so nil is more correct, but lots of
3391 other code uses `unspecified' as a generic value for face attributes. */
3392 if (!UNSPECIFIEDP (from[LFACE_INHERIT_INDEX])
3393 && !NILP (from[LFACE_INHERIT_INDEX]))
3394 merge_face_inheritance (f, from[LFACE_INHERIT_INDEX], to, cycle_check);
3396 /* If TO specifies a :font attribute, and FROM specifies some
3397 font-related attribute, we need to clear TO's :font attribute
3398 (because it will be inconsistent with whatever FROM specifies, and
3399 FROM takes precedence). */
3400 if (!NILP (to[LFACE_FONT_INDEX])
3401 && (!UNSPECIFIEDP (from[LFACE_FAMILY_INDEX])
3402 || !UNSPECIFIEDP (from[LFACE_HEIGHT_INDEX])
3403 || !UNSPECIFIEDP (from[LFACE_WEIGHT_INDEX])
3404 || !UNSPECIFIEDP (from[LFACE_SLANT_INDEX])
3405 || !UNSPECIFIEDP (from[LFACE_SWIDTH_INDEX])
3406 || !UNSPECIFIEDP (from[LFACE_AVGWIDTH_INDEX])))
3407 to[LFACE_FONT_INDEX] = Qnil;
3409 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3410 if (!UNSPECIFIEDP (from[i]))
3412 if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i]))
3413 to[i] = merge_face_heights (from[i], to[i], to[i], cycle_check);
3414 else
3415 to[i] = from[i];
3418 /* TO is always an absolute face, which should inherit from nothing.
3419 We blindly copy the :inherit attribute above and fix it up here. */
3420 to[LFACE_INHERIT_INDEX] = Qnil;
3424 /* Checks the `cycle check' variable CHECK to see if it indicates that
3425 EL is part of a cycle; CHECK must be either Qnil or a value returned
3426 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3427 elements after which a cycle might be suspected; after that many
3428 elements, this macro begins consing in order to keep more precise
3429 track of elements.
3431 Returns nil if a cycle was detected, otherwise a new value for CHECK
3432 that includes EL.
3434 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3435 the caller should make sure that's ok. */
3437 #define CYCLE_CHECK(check, el, suspicious) \
3438 (NILP (check) \
3439 ? make_number (0) \
3440 : (INTEGERP (check) \
3441 ? (XFASTINT (check) < (suspicious) \
3442 ? make_number (XFASTINT (check) + 1) \
3443 : Fcons (el, Qnil)) \
3444 : (!NILP (Fmemq ((el), (check))) \
3445 ? Qnil \
3446 : Fcons ((el), (check)))))
3449 /* Merge face attributes from the face on frame F whose name is
3450 INHERITS, into the vector of face attributes TO; INHERITS may also be
3451 a list of face names, in which case they are applied in order.
3452 CYCLE_CHECK is used to detect loops in face inheritance.
3453 Returns true if any of the inherited attributes are `font-related'. */
3455 static void
3456 merge_face_inheritance (f, inherit, to, cycle_check)
3457 struct frame *f;
3458 Lisp_Object inherit;
3459 Lisp_Object *to;
3460 Lisp_Object cycle_check;
3462 if (SYMBOLP (inherit) && !EQ (inherit, Qunspecified))
3463 /* Inherit from the named face INHERIT. */
3465 Lisp_Object lface;
3467 /* Make sure we're not in an inheritance loop. */
3468 cycle_check = CYCLE_CHECK (cycle_check, inherit, 15);
3469 if (NILP (cycle_check))
3470 /* Cycle detected, ignore any further inheritance. */
3471 return;
3473 lface = lface_from_face_name (f, inherit, 0);
3474 if (!NILP (lface))
3475 merge_face_vectors (f, XVECTOR (lface)->contents, to, cycle_check);
3477 else if (CONSP (inherit))
3478 /* Handle a list of inherited faces by calling ourselves recursively
3479 on each element. Note that we only do so for symbol elements, so
3480 it's not possible to infinitely recurse. */
3482 while (CONSP (inherit))
3484 if (SYMBOLP (XCAR (inherit)))
3485 merge_face_inheritance (f, XCAR (inherit), to, cycle_check);
3487 /* Check for a circular inheritance list. */
3488 cycle_check = CYCLE_CHECK (cycle_check, inherit, 15);
3489 if (NILP (cycle_check))
3490 /* Cycle detected. */
3491 break;
3493 inherit = XCDR (inherit);
3499 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3500 is a face property, determine the resulting face attributes on
3501 frame F, and store them in TO. PROP may be a single face
3502 specification or a list of such specifications. Each face
3503 specification can be
3505 1. A symbol or string naming a Lisp face.
3507 2. A property list of the form (KEYWORD VALUE ...) where each
3508 KEYWORD is a face attribute name, and value is an appropriate value
3509 for that attribute.
3511 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3512 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3513 for compatibility with 20.2.
3515 Face specifications earlier in lists take precedence over later
3516 specifications. */
3518 static void
3519 merge_face_vector_with_property (f, to, prop)
3520 struct frame *f;
3521 Lisp_Object *to;
3522 Lisp_Object prop;
3524 if (CONSP (prop))
3526 Lisp_Object first = XCAR (prop);
3528 if (EQ (first, Qforeground_color)
3529 || EQ (first, Qbackground_color))
3531 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3532 . COLOR). COLOR must be a string. */
3533 Lisp_Object color_name = XCDR (prop);
3534 Lisp_Object color = first;
3536 if (STRINGP (color_name))
3538 if (EQ (color, Qforeground_color))
3539 to[LFACE_FOREGROUND_INDEX] = color_name;
3540 else
3541 to[LFACE_BACKGROUND_INDEX] = color_name;
3543 else
3544 add_to_log ("Invalid face color", color_name, Qnil);
3546 else if (SYMBOLP (first)
3547 && *SDATA (SYMBOL_NAME (first)) == ':')
3549 /* Assume this is the property list form. */
3550 while (CONSP (prop) && CONSP (XCDR (prop)))
3552 Lisp_Object keyword = XCAR (prop);
3553 Lisp_Object value = XCAR (XCDR (prop));
3555 if (EQ (keyword, QCfamily))
3557 if (STRINGP (value))
3558 to[LFACE_FAMILY_INDEX] = value;
3559 else
3560 add_to_log ("Invalid face font family", value, Qnil);
3562 else if (EQ (keyword, QCheight))
3564 Lisp_Object new_height =
3565 merge_face_heights (value, to[LFACE_HEIGHT_INDEX],
3566 Qnil, Qnil);
3568 if (NILP (new_height))
3569 add_to_log ("Invalid face font height", value, Qnil);
3570 else
3571 to[LFACE_HEIGHT_INDEX] = new_height;
3573 else if (EQ (keyword, QCweight))
3575 if (SYMBOLP (value)
3576 && face_numeric_weight (value) >= 0)
3577 to[LFACE_WEIGHT_INDEX] = value;
3578 else
3579 add_to_log ("Invalid face weight", value, Qnil);
3581 else if (EQ (keyword, QCslant))
3583 if (SYMBOLP (value)
3584 && face_numeric_slant (value) >= 0)
3585 to[LFACE_SLANT_INDEX] = value;
3586 else
3587 add_to_log ("Invalid face slant", value, Qnil);
3589 else if (EQ (keyword, QCunderline))
3591 if (EQ (value, Qt)
3592 || NILP (value)
3593 || STRINGP (value))
3594 to[LFACE_UNDERLINE_INDEX] = value;
3595 else
3596 add_to_log ("Invalid face underline", value, Qnil);
3598 else if (EQ (keyword, QCoverline))
3600 if (EQ (value, Qt)
3601 || NILP (value)
3602 || STRINGP (value))
3603 to[LFACE_OVERLINE_INDEX] = value;
3604 else
3605 add_to_log ("Invalid face overline", value, Qnil);
3607 else if (EQ (keyword, QCstrike_through))
3609 if (EQ (value, Qt)
3610 || NILP (value)
3611 || STRINGP (value))
3612 to[LFACE_STRIKE_THROUGH_INDEX] = value;
3613 else
3614 add_to_log ("Invalid face strike-through", value, Qnil);
3616 else if (EQ (keyword, QCbox))
3618 if (EQ (value, Qt))
3619 value = make_number (1);
3620 if (INTEGERP (value)
3621 || STRINGP (value)
3622 || CONSP (value)
3623 || NILP (value))
3624 to[LFACE_BOX_INDEX] = value;
3625 else
3626 add_to_log ("Invalid face box", value, Qnil);
3628 else if (EQ (keyword, QCinverse_video)
3629 || EQ (keyword, QCreverse_video))
3631 if (EQ (value, Qt) || NILP (value))
3632 to[LFACE_INVERSE_INDEX] = value;
3633 else
3634 add_to_log ("Invalid face inverse-video", value, Qnil);
3636 else if (EQ (keyword, QCforeground))
3638 if (STRINGP (value))
3639 to[LFACE_FOREGROUND_INDEX] = value;
3640 else
3641 add_to_log ("Invalid face foreground", value, Qnil);
3643 else if (EQ (keyword, QCbackground))
3645 if (STRINGP (value))
3646 to[LFACE_BACKGROUND_INDEX] = value;
3647 else
3648 add_to_log ("Invalid face background", value, Qnil);
3650 else if (EQ (keyword, QCstipple))
3652 #ifdef HAVE_X_WINDOWS
3653 Lisp_Object pixmap_p = Fbitmap_spec_p (value);
3654 if (!NILP (pixmap_p))
3655 to[LFACE_STIPPLE_INDEX] = value;
3656 else
3657 add_to_log ("Invalid face stipple", value, Qnil);
3658 #endif
3660 else if (EQ (keyword, QCwidth))
3662 if (SYMBOLP (value)
3663 && face_numeric_swidth (value) >= 0)
3664 to[LFACE_SWIDTH_INDEX] = value;
3665 else
3666 add_to_log ("Invalid face width", value, Qnil);
3668 else if (EQ (keyword, QCinherit))
3670 if (SYMBOLP (value))
3671 to[LFACE_INHERIT_INDEX] = value;
3672 else
3674 Lisp_Object tail;
3675 for (tail = value; CONSP (tail); tail = XCDR (tail))
3676 if (!SYMBOLP (XCAR (tail)))
3677 break;
3678 if (NILP (tail))
3679 to[LFACE_INHERIT_INDEX] = value;
3680 else
3681 add_to_log ("Invalid face inherit", value, Qnil);
3684 else
3685 add_to_log ("Invalid attribute %s in face property",
3686 keyword, Qnil);
3688 prop = XCDR (XCDR (prop));
3691 else
3693 /* This is a list of face specs. Specifications at the
3694 beginning of the list take precedence over later
3695 specifications, so we have to merge starting with the
3696 last specification. */
3697 Lisp_Object next = XCDR (prop);
3698 if (!NILP (next))
3699 merge_face_vector_with_property (f, to, next);
3700 merge_face_vector_with_property (f, to, first);
3703 else
3705 /* PROP ought to be a face name. */
3706 Lisp_Object lface = lface_from_face_name (f, prop, 0);
3707 if (NILP (lface))
3708 add_to_log ("Invalid face text property value: %s", prop, Qnil);
3709 else
3710 merge_face_vectors (f, XVECTOR (lface)->contents, to, Qnil);
3715 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
3716 Sinternal_make_lisp_face, 1, 2, 0,
3717 doc: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3718 If FACE was not known as a face before, create a new one.
3719 If optional argument FRAME is specified, make a frame-local face
3720 for that frame. Otherwise operate on the global face definition.
3721 Value is a vector of face attributes. */)
3722 (face, frame)
3723 Lisp_Object face, frame;
3725 Lisp_Object global_lface, lface;
3726 struct frame *f;
3727 int i;
3729 CHECK_SYMBOL (face);
3730 global_lface = lface_from_face_name (NULL, face, 0);
3732 if (!NILP (frame))
3734 CHECK_LIVE_FRAME (frame);
3735 f = XFRAME (frame);
3736 lface = lface_from_face_name (f, face, 0);
3738 else
3739 f = NULL, lface = Qnil;
3741 /* Add a global definition if there is none. */
3742 if (NILP (global_lface))
3744 global_lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
3745 Qunspecified);
3746 AREF (global_lface, 0) = Qface;
3747 Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
3748 Vface_new_frame_defaults);
3750 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3751 face id to Lisp face is given by the vector lface_id_to_name.
3752 The mapping from Lisp face to Lisp face id is given by the
3753 property `face' of the Lisp face name. */
3754 if (next_lface_id == lface_id_to_name_size)
3756 int new_size = max (50, 2 * lface_id_to_name_size);
3757 int sz = new_size * sizeof *lface_id_to_name;
3758 lface_id_to_name = (Lisp_Object *) xrealloc (lface_id_to_name, sz);
3759 lface_id_to_name_size = new_size;
3762 lface_id_to_name[next_lface_id] = face;
3763 Fput (face, Qface, make_number (next_lface_id));
3764 ++next_lface_id;
3766 else if (f == NULL)
3767 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3768 AREF (global_lface, i) = Qunspecified;
3770 /* Add a frame-local definition. */
3771 if (f)
3773 if (NILP (lface))
3775 lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
3776 Qunspecified);
3777 AREF (lface, 0) = Qface;
3778 f->face_alist = Fcons (Fcons (face, lface), f->face_alist);
3780 else
3781 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3782 AREF (lface, i) = Qunspecified;
3784 else
3785 lface = global_lface;
3787 /* Changing a named face means that all realized faces depending on
3788 that face are invalid. Since we cannot tell which realized faces
3789 depend on the face, make sure they are all removed. This is done
3790 by incrementing face_change_count. The next call to
3791 init_iterator will then free realized faces. */
3792 ++face_change_count;
3793 ++windows_or_buffers_changed;
3795 xassert (LFACEP (lface));
3796 check_lface (lface);
3797 return lface;
3801 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p,
3802 Sinternal_lisp_face_p, 1, 2, 0,
3803 doc: /* Return non-nil if FACE names a face.
3804 If optional second parameter FRAME is non-nil, check for the
3805 existence of a frame-local face with name FACE on that frame.
3806 Otherwise check for the existence of a global face. */)
3807 (face, frame)
3808 Lisp_Object face, frame;
3810 Lisp_Object lface;
3812 if (!NILP (frame))
3814 CHECK_LIVE_FRAME (frame);
3815 lface = lface_from_face_name (XFRAME (frame), face, 0);
3817 else
3818 lface = lface_from_face_name (NULL, face, 0);
3820 return lface;
3824 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face,
3825 Sinternal_copy_lisp_face, 4, 4, 0,
3826 doc: /* Copy face FROM to TO.
3827 If FRAME it t, copy the global face definition of FROM to the
3828 global face definition of TO. Otherwise, copy the frame-local
3829 definition of FROM on FRAME to the frame-local definition of TO
3830 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3832 Value is TO. */)
3833 (from, to, frame, new_frame)
3834 Lisp_Object from, to, frame, new_frame;
3836 Lisp_Object lface, copy;
3838 CHECK_SYMBOL (from);
3839 CHECK_SYMBOL (to);
3840 if (NILP (new_frame))
3841 new_frame = frame;
3843 if (EQ (frame, Qt))
3845 /* Copy global definition of FROM. We don't make copies of
3846 strings etc. because 20.2 didn't do it either. */
3847 lface = lface_from_face_name (NULL, from, 1);
3848 copy = Finternal_make_lisp_face (to, Qnil);
3850 else
3852 /* Copy frame-local definition of FROM. */
3853 CHECK_LIVE_FRAME (frame);
3854 CHECK_LIVE_FRAME (new_frame);
3855 lface = lface_from_face_name (XFRAME (frame), from, 1);
3856 copy = Finternal_make_lisp_face (to, new_frame);
3859 bcopy (XVECTOR (lface)->contents, XVECTOR (copy)->contents,
3860 LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
3862 /* Changing a named face means that all realized faces depending on
3863 that face are invalid. Since we cannot tell which realized faces
3864 depend on the face, make sure they are all removed. This is done
3865 by incrementing face_change_count. The next call to
3866 init_iterator will then free realized faces. */
3867 ++face_change_count;
3868 ++windows_or_buffers_changed;
3870 return to;
3874 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
3875 Sinternal_set_lisp_face_attribute, 3, 4, 0,
3876 doc: /* Set attribute ATTR of FACE to VALUE.
3877 FRAME being a frame means change the face on that frame.
3878 FRAME nil means change the face of the selected frame.
3879 FRAME t means change the default for new frames.
3880 FRAME 0 means change the face on all frames, and change the default
3881 for new frames. */)
3882 (face, attr, value, frame)
3883 Lisp_Object face, attr, value, frame;
3885 Lisp_Object lface;
3886 Lisp_Object old_value = Qnil;
3887 /* Set 1 if ATTR is QCfont. */
3888 int font_attr_p = 0;
3889 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3890 int font_related_attr_p = 0;
3892 CHECK_SYMBOL (face);
3893 CHECK_SYMBOL (attr);
3895 face = resolve_face_name (face);
3897 /* If FRAME is 0, change face on all frames, and change the
3898 default for new frames. */
3899 if (INTEGERP (frame) && XINT (frame) == 0)
3901 Lisp_Object tail;
3902 Finternal_set_lisp_face_attribute (face, attr, value, Qt);
3903 FOR_EACH_FRAME (tail, frame)
3904 Finternal_set_lisp_face_attribute (face, attr, value, frame);
3905 return face;
3908 /* Set lface to the Lisp attribute vector of FACE. */
3909 if (EQ (frame, Qt))
3910 lface = lface_from_face_name (NULL, face, 1);
3911 else
3913 if (NILP (frame))
3914 frame = selected_frame;
3916 CHECK_LIVE_FRAME (frame);
3917 lface = lface_from_face_name (XFRAME (frame), face, 0);
3919 /* If a frame-local face doesn't exist yet, create one. */
3920 if (NILP (lface))
3921 lface = Finternal_make_lisp_face (face, frame);
3924 if (EQ (attr, QCfamily))
3926 if (!UNSPECIFIEDP (value))
3928 CHECK_STRING (value);
3929 if (SCHARS (value) == 0)
3930 signal_error ("Invalid face family", value);
3932 old_value = LFACE_FAMILY (lface);
3933 LFACE_FAMILY (lface) = value;
3934 font_related_attr_p = 1;
3936 else if (EQ (attr, QCheight))
3938 if (!UNSPECIFIEDP (value))
3940 Lisp_Object test;
3942 test = (EQ (face, Qdefault)
3943 ? value
3944 /* The default face must have an absolute size,
3945 otherwise, we do a test merge with a random
3946 height to see if VALUE's ok. */
3947 : merge_face_heights (value, make_number (10), Qnil, Qnil));
3949 if (!INTEGERP (test) || XINT (test) <= 0)
3950 signal_error ("Invalid face height", value);
3953 old_value = LFACE_HEIGHT (lface);
3954 LFACE_HEIGHT (lface) = value;
3955 font_related_attr_p = 1;
3957 else if (EQ (attr, QCweight))
3959 if (!UNSPECIFIEDP (value))
3961 CHECK_SYMBOL (value);
3962 if (face_numeric_weight (value) < 0)
3963 signal_error ("Invalid face weight", value);
3965 old_value = LFACE_WEIGHT (lface);
3966 LFACE_WEIGHT (lface) = value;
3967 font_related_attr_p = 1;
3969 else if (EQ (attr, QCslant))
3971 if (!UNSPECIFIEDP (value))
3973 CHECK_SYMBOL (value);
3974 if (face_numeric_slant (value) < 0)
3975 signal_error ("Invalid face slant", value);
3977 old_value = LFACE_SLANT (lface);
3978 LFACE_SLANT (lface) = value;
3979 font_related_attr_p = 1;
3981 else if (EQ (attr, QCunderline))
3983 if (!UNSPECIFIEDP (value))
3984 if ((SYMBOLP (value)
3985 && !EQ (value, Qt)
3986 && !EQ (value, Qnil))
3987 /* Underline color. */
3988 || (STRINGP (value)
3989 && SCHARS (value) == 0))
3990 signal_error ("Invalid face underline", value);
3992 old_value = LFACE_UNDERLINE (lface);
3993 LFACE_UNDERLINE (lface) = value;
3995 else if (EQ (attr, QCoverline))
3997 if (!UNSPECIFIEDP (value))
3998 if ((SYMBOLP (value)
3999 && !EQ (value, Qt)
4000 && !EQ (value, Qnil))
4001 /* Overline color. */
4002 || (STRINGP (value)
4003 && SCHARS (value) == 0))
4004 signal_error ("Invalid face overline", value);
4006 old_value = LFACE_OVERLINE (lface);
4007 LFACE_OVERLINE (lface) = value;
4009 else if (EQ (attr, QCstrike_through))
4011 if (!UNSPECIFIEDP (value))
4012 if ((SYMBOLP (value)
4013 && !EQ (value, Qt)
4014 && !EQ (value, Qnil))
4015 /* Strike-through color. */
4016 || (STRINGP (value)
4017 && SCHARS (value) == 0))
4018 signal_error ("Invalid face strike-through", value);
4020 old_value = LFACE_STRIKE_THROUGH (lface);
4021 LFACE_STRIKE_THROUGH (lface) = value;
4023 else if (EQ (attr, QCbox))
4025 int valid_p;
4027 /* Allow t meaning a simple box of width 1 in foreground color
4028 of the face. */
4029 if (EQ (value, Qt))
4030 value = make_number (1);
4032 if (UNSPECIFIEDP (value))
4033 valid_p = 1;
4034 else if (NILP (value))
4035 valid_p = 1;
4036 else if (INTEGERP (value))
4037 valid_p = XINT (value) != 0;
4038 else if (STRINGP (value))
4039 valid_p = SCHARS (value) > 0;
4040 else if (CONSP (value))
4042 Lisp_Object tem;
4044 tem = value;
4045 while (CONSP (tem))
4047 Lisp_Object k, v;
4049 k = XCAR (tem);
4050 tem = XCDR (tem);
4051 if (!CONSP (tem))
4052 break;
4053 v = XCAR (tem);
4054 tem = XCDR (tem);
4056 if (EQ (k, QCline_width))
4058 if (!INTEGERP (v) || XINT (v) == 0)
4059 break;
4061 else if (EQ (k, QCcolor))
4063 if (!STRINGP (v) || SCHARS (v) == 0)
4064 break;
4066 else if (EQ (k, QCstyle))
4068 if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button))
4069 break;
4071 else
4072 break;
4075 valid_p = NILP (tem);
4077 else
4078 valid_p = 0;
4080 if (!valid_p)
4081 signal_error ("Invalid face box", value);
4083 old_value = LFACE_BOX (lface);
4084 LFACE_BOX (lface) = value;
4086 else if (EQ (attr, QCinverse_video)
4087 || EQ (attr, QCreverse_video))
4089 if (!UNSPECIFIEDP (value))
4091 CHECK_SYMBOL (value);
4092 if (!EQ (value, Qt) && !NILP (value))
4093 signal_error ("Invalid inverse-video face attribute value", value);
4095 old_value = LFACE_INVERSE (lface);
4096 LFACE_INVERSE (lface) = value;
4098 else if (EQ (attr, QCforeground))
4100 if (!UNSPECIFIEDP (value))
4102 /* Don't check for valid color names here because it depends
4103 on the frame (display) whether the color will be valid
4104 when the face is realized. */
4105 CHECK_STRING (value);
4106 if (SCHARS (value) == 0)
4107 signal_error ("Empty foreground color value", value);
4109 old_value = LFACE_FOREGROUND (lface);
4110 LFACE_FOREGROUND (lface) = value;
4112 else if (EQ (attr, QCbackground))
4114 if (!UNSPECIFIEDP (value))
4116 /* Don't check for valid color names here because it depends
4117 on the frame (display) whether the color will be valid
4118 when the face is realized. */
4119 CHECK_STRING (value);
4120 if (SCHARS (value) == 0)
4121 signal_error ("Empty background color value", value);
4123 old_value = LFACE_BACKGROUND (lface);
4124 LFACE_BACKGROUND (lface) = value;
4126 else if (EQ (attr, QCstipple))
4128 #ifdef HAVE_X_WINDOWS
4129 if (!UNSPECIFIEDP (value)
4130 && !NILP (value)
4131 && NILP (Fbitmap_spec_p (value)))
4132 signal_error ("Invalid stipple attribute", value);
4133 old_value = LFACE_STIPPLE (lface);
4134 LFACE_STIPPLE (lface) = value;
4135 #endif /* HAVE_X_WINDOWS */
4137 else if (EQ (attr, QCwidth))
4139 if (!UNSPECIFIEDP (value))
4141 CHECK_SYMBOL (value);
4142 if (face_numeric_swidth (value) < 0)
4143 signal_error ("Invalid face width", value);
4145 old_value = LFACE_SWIDTH (lface);
4146 LFACE_SWIDTH (lface) = value;
4147 font_related_attr_p = 1;
4149 else if (EQ (attr, QCfont))
4151 #ifdef HAVE_WINDOW_SYSTEM
4152 if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame)))
4154 /* Set font-related attributes of the Lisp face from an XLFD
4155 font name. */
4156 struct frame *f;
4157 Lisp_Object tmp;
4159 CHECK_STRING (value);
4160 if (EQ (frame, Qt))
4161 f = SELECTED_FRAME ();
4162 else
4163 f = check_x_frame (frame);
4165 /* VALUE may be a fontset name or an alias of fontset. In
4166 such a case, use the base fontset name. */
4167 tmp = Fquery_fontset (value, Qnil);
4168 if (!NILP (tmp))
4169 value = tmp;
4171 if (!set_lface_from_font_name (f, lface, value, 1, 1))
4172 signal_error ("Invalid font or fontset name", value);
4174 font_attr_p = 1;
4176 #endif /* HAVE_WINDOW_SYSTEM */
4178 else if (EQ (attr, QCinherit))
4180 Lisp_Object tail;
4181 if (SYMBOLP (value))
4182 tail = Qnil;
4183 else
4184 for (tail = value; CONSP (tail); tail = XCDR (tail))
4185 if (!SYMBOLP (XCAR (tail)))
4186 break;
4187 if (NILP (tail))
4188 LFACE_INHERIT (lface) = value;
4189 else
4190 signal_error ("Invalid face inheritance", value);
4192 else if (EQ (attr, QCbold))
4194 old_value = LFACE_WEIGHT (lface);
4195 LFACE_WEIGHT (lface) = NILP (value) ? Qnormal : Qbold;
4196 font_related_attr_p = 1;
4198 else if (EQ (attr, QCitalic))
4200 old_value = LFACE_SLANT (lface);
4201 LFACE_SLANT (lface) = NILP (value) ? Qnormal : Qitalic;
4202 font_related_attr_p = 1;
4204 else
4205 signal_error ("Invalid face attribute name", attr);
4207 if (font_related_attr_p
4208 && !UNSPECIFIEDP (value))
4209 /* If a font-related attribute other than QCfont is specified, the
4210 original `font' attribute nor that of default face is useless
4211 to determine a new font. Thus, we set it to nil so that font
4212 selection mechanism doesn't use it. */
4213 LFACE_FONT (lface) = Qnil;
4215 /* Changing a named face means that all realized faces depending on
4216 that face are invalid. Since we cannot tell which realized faces
4217 depend on the face, make sure they are all removed. This is done
4218 by incrementing face_change_count. The next call to
4219 init_iterator will then free realized faces. */
4220 if (!EQ (frame, Qt)
4221 && (EQ (attr, QCfont)
4222 || NILP (Fequal (old_value, value))))
4224 ++face_change_count;
4225 ++windows_or_buffers_changed;
4228 if (!UNSPECIFIEDP (value)
4229 && NILP (Fequal (old_value, value)))
4231 Lisp_Object param;
4233 param = Qnil;
4235 if (EQ (face, Qdefault))
4237 #ifdef HAVE_WINDOW_SYSTEM
4238 /* Changed font-related attributes of the `default' face are
4239 reflected in changed `font' frame parameters. */
4240 if (FRAMEP (frame)
4241 && (font_related_attr_p || font_attr_p)
4242 && lface_fully_specified_p (XVECTOR (lface)->contents))
4243 set_font_frame_param (frame, lface);
4244 else
4245 #endif /* HAVE_WINDOW_SYSTEM */
4247 if (EQ (attr, QCforeground))
4248 param = Qforeground_color;
4249 else if (EQ (attr, QCbackground))
4250 param = Qbackground_color;
4252 #ifdef HAVE_WINDOW_SYSTEM
4253 #ifndef WINDOWSNT
4254 else if (EQ (face, Qscroll_bar))
4256 /* Changing the colors of `scroll-bar' sets frame parameters
4257 `scroll-bar-foreground' and `scroll-bar-background'. */
4258 if (EQ (attr, QCforeground))
4259 param = Qscroll_bar_foreground;
4260 else if (EQ (attr, QCbackground))
4261 param = Qscroll_bar_background;
4263 #endif /* not WINDOWSNT */
4264 else if (EQ (face, Qborder))
4266 /* Changing background color of `border' sets frame parameter
4267 `border-color'. */
4268 if (EQ (attr, QCbackground))
4269 param = Qborder_color;
4271 else if (EQ (face, Qcursor))
4273 /* Changing background color of `cursor' sets frame parameter
4274 `cursor-color'. */
4275 if (EQ (attr, QCbackground))
4276 param = Qcursor_color;
4278 else if (EQ (face, Qmouse))
4280 /* Changing background color of `mouse' sets frame parameter
4281 `mouse-color'. */
4282 if (EQ (attr, QCbackground))
4283 param = Qmouse_color;
4285 #endif /* HAVE_WINDOW_SYSTEM */
4286 else if (EQ (face, Qmenu))
4288 /* Indicate that we have to update the menu bar when
4289 realizing faces on FRAME. FRAME t change the
4290 default for new frames. We do this by setting
4291 setting the flag in new face caches */
4292 if (FRAMEP (frame))
4294 struct frame *f = XFRAME (frame);
4295 if (FRAME_FACE_CACHE (f) == NULL)
4296 FRAME_FACE_CACHE (f) = make_face_cache (f);
4297 FRAME_FACE_CACHE (f)->menu_face_changed_p = 1;
4299 else
4300 menu_face_changed_default = 1;
4303 if (!NILP (param))
4305 if (EQ (frame, Qt))
4306 /* Update `default-frame-alist', which is used for new frames. */
4308 store_in_alist (&Vdefault_frame_alist, param, value);
4310 else
4311 /* Update the current frame's parameters. */
4313 Lisp_Object cons;
4314 cons = XCAR (Vparam_value_alist);
4315 XSETCAR (cons, param);
4316 XSETCDR (cons, value);
4317 Fmodify_frame_parameters (frame, Vparam_value_alist);
4322 return face;
4326 #ifdef HAVE_WINDOW_SYSTEM
4328 /* Set the `font' frame parameter of FRAME determined from `default'
4329 face attributes LFACE. If a face or fontset name is explicitely
4330 specfied in LFACE, use it as is. Otherwise, determine a font name
4331 from the other font-related atrributes of LFACE. In that case, if
4332 there's no matching font, signals an error. */
4334 static void
4335 set_font_frame_param (frame, lface)
4336 Lisp_Object frame, lface;
4338 struct frame *f = XFRAME (frame);
4340 if (FRAME_WINDOW_P (f))
4342 Lisp_Object font_name;
4343 char *font;
4345 if (STRINGP (LFACE_FONT (lface)))
4346 font_name = LFACE_FONT (lface);
4347 else
4349 /* Choose a font name that reflects LFACE's attributes and has
4350 the registry and encoding pattern specified in the default
4351 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4352 font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0, 0);
4353 if (!font)
4354 error ("No font matches the specified attribute");
4355 font_name = build_string (font);
4356 xfree (font);
4359 Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font_name), Qnil));
4364 /* Update the corresponding face when frame parameter PARAM on frame F
4365 has been assigned the value NEW_VALUE. */
4367 void
4368 update_face_from_frame_parameter (f, param, new_value)
4369 struct frame *f;
4370 Lisp_Object param, new_value;
4372 Lisp_Object lface;
4374 /* If there are no faces yet, give up. This is the case when called
4375 from Fx_create_frame, and we do the necessary things later in
4376 face-set-after-frame-defaults. */
4377 if (NILP (f->face_alist))
4378 return;
4380 /* Changing a named face means that all realized faces depending on
4381 that face are invalid. Since we cannot tell which realized faces
4382 depend on the face, make sure they are all removed. This is done
4383 by incrementing face_change_count. The next call to
4384 init_iterator will then free realized faces. */
4385 ++face_change_count;
4386 ++windows_or_buffers_changed;
4388 if (EQ (param, Qforeground_color))
4390 lface = lface_from_face_name (f, Qdefault, 1);
4391 LFACE_FOREGROUND (lface) = (STRINGP (new_value)
4392 ? new_value : Qunspecified);
4393 realize_basic_faces (f);
4395 else if (EQ (param, Qbackground_color))
4397 Lisp_Object frame;
4399 /* Changing the background color might change the background
4400 mode, so that we have to load new defface specs. Call
4401 frame-update-face-colors to do that. */
4402 XSETFRAME (frame, f);
4403 call1 (Qframe_update_face_colors, frame);
4405 lface = lface_from_face_name (f, Qdefault, 1);
4406 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4407 ? new_value : Qunspecified);
4408 realize_basic_faces (f);
4410 if (EQ (param, Qborder_color))
4412 lface = lface_from_face_name (f, Qborder, 1);
4413 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4414 ? new_value : Qunspecified);
4416 else if (EQ (param, Qcursor_color))
4418 lface = lface_from_face_name (f, Qcursor, 1);
4419 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4420 ? new_value : Qunspecified);
4422 else if (EQ (param, Qmouse_color))
4424 lface = lface_from_face_name (f, Qmouse, 1);
4425 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4426 ? new_value : Qunspecified);
4431 /* Get the value of X resource RESOURCE, class CLASS for the display
4432 of frame FRAME. This is here because ordinary `x-get-resource'
4433 doesn't take a frame argument. */
4435 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
4436 Sinternal_face_x_get_resource, 3, 3, 0, doc: /* */)
4437 (resource, class, frame)
4438 Lisp_Object resource, class, frame;
4440 Lisp_Object value = Qnil;
4441 #ifndef WINDOWSNT
4442 #ifndef MAC_OS
4443 CHECK_STRING (resource);
4444 CHECK_STRING (class);
4445 CHECK_LIVE_FRAME (frame);
4446 BLOCK_INPUT;
4447 value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
4448 resource, class, Qnil, Qnil);
4449 UNBLOCK_INPUT;
4450 #endif /* not MAC_OS */
4451 #endif /* not WINDOWSNT */
4452 return value;
4456 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4457 If VALUE is "on" or "true", return t. If VALUE is "off" or
4458 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4459 error; if SIGNAL_P is zero, return 0. */
4461 static Lisp_Object
4462 face_boolean_x_resource_value (value, signal_p)
4463 Lisp_Object value;
4464 int signal_p;
4466 Lisp_Object result = make_number (0);
4468 xassert (STRINGP (value));
4470 if (xstricmp (SDATA (value), "on") == 0
4471 || xstricmp (SDATA (value), "true") == 0)
4472 result = Qt;
4473 else if (xstricmp (SDATA (value), "off") == 0
4474 || xstricmp (SDATA (value), "false") == 0)
4475 result = Qnil;
4476 else if (xstricmp (SDATA (value), "unspecified") == 0)
4477 result = Qunspecified;
4478 else if (signal_p)
4479 signal_error ("Invalid face attribute value from X resource", value);
4481 return result;
4485 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4486 Finternal_set_lisp_face_attribute_from_resource,
4487 Sinternal_set_lisp_face_attribute_from_resource,
4488 3, 4, 0, doc: /* */)
4489 (face, attr, value, frame)
4490 Lisp_Object face, attr, value, frame;
4492 CHECK_SYMBOL (face);
4493 CHECK_SYMBOL (attr);
4494 CHECK_STRING (value);
4496 if (xstricmp (SDATA (value), "unspecified") == 0)
4497 value = Qunspecified;
4498 else if (EQ (attr, QCheight))
4500 value = Fstring_to_number (value, make_number (10));
4501 if (XINT (value) <= 0)
4502 signal_error ("Invalid face height from X resource", value);
4504 else if (EQ (attr, QCbold) || EQ (attr, QCitalic))
4505 value = face_boolean_x_resource_value (value, 1);
4506 else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth))
4507 value = intern (SDATA (value));
4508 else if (EQ (attr, QCreverse_video) || EQ (attr, QCinverse_video))
4509 value = face_boolean_x_resource_value (value, 1);
4510 else if (EQ (attr, QCunderline)
4511 || EQ (attr, QCoverline)
4512 || EQ (attr, QCstrike_through))
4514 Lisp_Object boolean_value;
4516 /* If the result of face_boolean_x_resource_value is t or nil,
4517 VALUE does NOT specify a color. */
4518 boolean_value = face_boolean_x_resource_value (value, 0);
4519 if (SYMBOLP (boolean_value))
4520 value = boolean_value;
4522 else if (EQ (attr, QCbox))
4523 value = Fcar (Fread_from_string (value, Qnil, Qnil));
4525 return Finternal_set_lisp_face_attribute (face, attr, value, frame);
4528 #endif /* HAVE_WINDOW_SYSTEM */
4531 /***********************************************************************
4532 Menu face
4533 ***********************************************************************/
4535 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4537 /* Make menus on frame F appear as specified by the `menu' face. */
4539 static void
4540 x_update_menu_appearance (f)
4541 struct frame *f;
4543 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4544 XrmDatabase rdb;
4546 if (dpyinfo
4547 && (rdb = XrmGetDatabase (FRAME_X_DISPLAY (f)),
4548 rdb != NULL))
4550 char line[512];
4551 Lisp_Object lface = lface_from_face_name (f, Qmenu, 1);
4552 struct face *face = FACE_FROM_ID (f, MENU_FACE_ID);
4553 const char *myname = SDATA (Vx_resource_name);
4554 int changed_p = 0;
4555 #ifdef USE_MOTIF
4556 const char *popup_path = "popup_menu";
4557 #else
4558 const char *popup_path = "menu.popup";
4559 #endif
4561 if (STRINGP (LFACE_FOREGROUND (lface)))
4563 sprintf (line, "%s.%s*foreground: %s",
4564 myname, popup_path,
4565 SDATA (LFACE_FOREGROUND (lface)));
4566 XrmPutLineResource (&rdb, line);
4567 sprintf (line, "%s.pane.menubar*foreground: %s",
4568 myname, SDATA (LFACE_FOREGROUND (lface)));
4569 XrmPutLineResource (&rdb, line);
4570 changed_p = 1;
4573 if (STRINGP (LFACE_BACKGROUND (lface)))
4575 sprintf (line, "%s.%s*background: %s",
4576 myname, popup_path,
4577 SDATA (LFACE_BACKGROUND (lface)));
4578 XrmPutLineResource (&rdb, line);
4579 sprintf (line, "%s.pane.menubar*background: %s",
4580 myname, SDATA (LFACE_BACKGROUND (lface)));
4581 XrmPutLineResource (&rdb, line);
4582 changed_p = 1;
4585 if (face->font_name
4586 && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
4587 || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
4588 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface))
4589 || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
4590 || !UNSPECIFIEDP (LFACE_SLANT (lface))
4591 || !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
4593 #ifdef USE_MOTIF
4594 const char *suffix = "List";
4595 #else
4596 const char *suffix = "";
4597 #endif
4598 sprintf (line, "%s.pane.menubar*font%s: %s",
4599 myname, suffix, face->font_name);
4600 XrmPutLineResource (&rdb, line);
4601 sprintf (line, "%s.%s*font%s: %s",
4602 myname, popup_path, suffix, face->font_name);
4603 XrmPutLineResource (&rdb, line);
4604 changed_p = 1;
4607 if (changed_p && f->output_data.x->menubar_widget)
4608 free_frame_menubar (f);
4612 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4615 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
4616 Sface_attribute_relative_p,
4617 2, 2, 0,
4618 doc: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4619 (attribute, value)
4620 Lisp_Object attribute, value;
4622 if (EQ (value, Qunspecified))
4623 return Qt;
4624 else if (EQ (attribute, QCheight))
4625 return INTEGERP (value) ? Qnil : Qt;
4626 else
4627 return Qnil;
4630 DEFUN ("merge-face-attribute", Fmerge_face_attribute, Smerge_face_attribute,
4631 3, 3, 0,
4632 doc: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4633 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4634 the result will be absolute, otherwise it will be relative. */)
4635 (attribute, value1, value2)
4636 Lisp_Object attribute, value1, value2;
4638 if (EQ (value1, Qunspecified))
4639 return value2;
4640 else if (EQ (attribute, QCheight))
4641 return merge_face_heights (value1, value2, value1, Qnil);
4642 else
4643 return value1;
4647 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute,
4648 Sinternal_get_lisp_face_attribute,
4649 2, 3, 0,
4650 doc: /* Return face attribute KEYWORD of face SYMBOL.
4651 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4652 face attribute name, signal an error.
4653 If the optional argument FRAME is given, report on face FACE in that
4654 frame. If FRAME is t, report on the defaults for face FACE (for new
4655 frames). If FRAME is omitted or nil, use the selected frame. */)
4656 (symbol, keyword, frame)
4657 Lisp_Object symbol, keyword, frame;
4659 Lisp_Object lface, value = Qnil;
4661 CHECK_SYMBOL (symbol);
4662 CHECK_SYMBOL (keyword);
4664 if (EQ (frame, Qt))
4665 lface = lface_from_face_name (NULL, symbol, 1);
4666 else
4668 if (NILP (frame))
4669 frame = selected_frame;
4670 CHECK_LIVE_FRAME (frame);
4671 lface = lface_from_face_name (XFRAME (frame), symbol, 1);
4674 if (EQ (keyword, QCfamily))
4675 value = LFACE_FAMILY (lface);
4676 else if (EQ (keyword, QCheight))
4677 value = LFACE_HEIGHT (lface);
4678 else if (EQ (keyword, QCweight))
4679 value = LFACE_WEIGHT (lface);
4680 else if (EQ (keyword, QCslant))
4681 value = LFACE_SLANT (lface);
4682 else if (EQ (keyword, QCunderline))
4683 value = LFACE_UNDERLINE (lface);
4684 else if (EQ (keyword, QCoverline))
4685 value = LFACE_OVERLINE (lface);
4686 else if (EQ (keyword, QCstrike_through))
4687 value = LFACE_STRIKE_THROUGH (lface);
4688 else if (EQ (keyword, QCbox))
4689 value = LFACE_BOX (lface);
4690 else if (EQ (keyword, QCinverse_video)
4691 || EQ (keyword, QCreverse_video))
4692 value = LFACE_INVERSE (lface);
4693 else if (EQ (keyword, QCforeground))
4694 value = LFACE_FOREGROUND (lface);
4695 else if (EQ (keyword, QCbackground))
4696 value = LFACE_BACKGROUND (lface);
4697 else if (EQ (keyword, QCstipple))
4698 value = LFACE_STIPPLE (lface);
4699 else if (EQ (keyword, QCwidth))
4700 value = LFACE_SWIDTH (lface);
4701 else if (EQ (keyword, QCinherit))
4702 value = LFACE_INHERIT (lface);
4703 else if (EQ (keyword, QCfont))
4704 value = LFACE_FONT (lface);
4705 else
4706 signal_error ("Invalid face attribute name", keyword);
4708 return value;
4712 DEFUN ("internal-lisp-face-attribute-values",
4713 Finternal_lisp_face_attribute_values,
4714 Sinternal_lisp_face_attribute_values, 1, 1, 0,
4715 doc: /* Return a list of valid discrete values for face attribute ATTR.
4716 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4717 (attr)
4718 Lisp_Object attr;
4720 Lisp_Object result = Qnil;
4722 CHECK_SYMBOL (attr);
4724 if (EQ (attr, QCweight)
4725 || EQ (attr, QCslant)
4726 || EQ (attr, QCwidth))
4728 /* Extract permissible symbols from tables. */
4729 struct table_entry *table;
4730 int i, dim;
4732 if (EQ (attr, QCweight))
4733 table = weight_table, dim = DIM (weight_table);
4734 else if (EQ (attr, QCslant))
4735 table = slant_table, dim = DIM (slant_table);
4736 else
4737 table = swidth_table, dim = DIM (swidth_table);
4739 for (i = 0; i < dim; ++i)
4741 Lisp_Object symbol = *table[i].symbol;
4742 Lisp_Object tail = result;
4744 while (!NILP (tail)
4745 && !EQ (XCAR (tail), symbol))
4746 tail = XCDR (tail);
4748 if (NILP (tail))
4749 result = Fcons (symbol, result);
4752 else if (EQ (attr, QCunderline))
4753 result = Fcons (Qt, Fcons (Qnil, Qnil));
4754 else if (EQ (attr, QCoverline))
4755 result = Fcons (Qt, Fcons (Qnil, Qnil));
4756 else if (EQ (attr, QCstrike_through))
4757 result = Fcons (Qt, Fcons (Qnil, Qnil));
4758 else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
4759 result = Fcons (Qt, Fcons (Qnil, Qnil));
4761 return result;
4765 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face,
4766 Sinternal_merge_in_global_face, 2, 2, 0,
4767 doc: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4768 Default face attributes override any local face attributes. */)
4769 (face, frame)
4770 Lisp_Object face, frame;
4772 int i;
4773 Lisp_Object global_lface, local_lface, *gvec, *lvec;
4775 CHECK_LIVE_FRAME (frame);
4776 global_lface = lface_from_face_name (NULL, face, 1);
4777 local_lface = lface_from_face_name (XFRAME (frame), face, 0);
4778 if (NILP (local_lface))
4779 local_lface = Finternal_make_lisp_face (face, frame);
4781 /* Make every specified global attribute override the local one.
4782 BEWARE!! This is only used from `face-set-after-frame-default' where
4783 the local frame is defined from default specs in `face-defface-spec'
4784 and those should be overridden by global settings. Hence the strange
4785 "global before local" priority. */
4786 lvec = XVECTOR (local_lface)->contents;
4787 gvec = XVECTOR (global_lface)->contents;
4788 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
4789 if (! UNSPECIFIEDP (gvec[i]))
4790 lvec[i] = gvec[i];
4792 return Qnil;
4796 /* The following function is implemented for compatibility with 20.2.
4797 The function is used in x-resolve-fonts when it is asked to
4798 return fonts with the same size as the font of a face. This is
4799 done in fontset.el. */
4801 DEFUN ("face-font", Fface_font, Sface_font, 1, 2, 0,
4802 doc: /* Return the font name of face FACE, or nil if it is unspecified.
4803 If the optional argument FRAME is given, report on face FACE in that frame.
4804 If FRAME is t, report on the defaults for face FACE (for new frames).
4805 The font default for a face is either nil, or a list
4806 of the form (bold), (italic) or (bold italic).
4807 If FRAME is omitted or nil, use the selected frame. */)
4808 (face, frame)
4809 Lisp_Object face, frame;
4811 if (EQ (frame, Qt))
4813 Lisp_Object result = Qnil;
4814 Lisp_Object lface = lface_from_face_name (NULL, face, 1);
4816 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface))
4817 && !EQ (LFACE_WEIGHT (lface), Qnormal))
4818 result = Fcons (Qbold, result);
4820 if (!UNSPECIFIEDP (LFACE_SLANT (lface))
4821 && !EQ (LFACE_SLANT (lface), Qnormal))
4822 result = Fcons (Qitalic, result);
4824 return result;
4826 else
4828 struct frame *f = frame_or_selected_frame (frame, 1);
4829 int face_id = lookup_named_face (f, face, 0);
4830 struct face *face = FACE_FROM_ID (f, face_id);
4831 return face ? build_string (face->font_name) : Qnil;
4836 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4837 all attributes are `equal'. Tries to be fast because this function
4838 is called quite often. */
4840 static INLINE int
4841 lface_equal_p (v1, v2)
4842 Lisp_Object *v1, *v2;
4844 int i, equal_p = 1;
4846 for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i)
4848 Lisp_Object a = v1[i];
4849 Lisp_Object b = v2[i];
4851 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4852 and the other is specified. */
4853 equal_p = XTYPE (a) == XTYPE (b);
4854 if (!equal_p)
4855 break;
4857 if (!EQ (a, b))
4859 switch (XTYPE (a))
4861 case Lisp_String:
4862 equal_p = ((SBYTES (a)
4863 == SBYTES (b))
4864 && bcmp (SDATA (a), SDATA (b),
4865 SBYTES (a)) == 0);
4866 break;
4868 case Lisp_Int:
4869 case Lisp_Symbol:
4870 equal_p = 0;
4871 break;
4873 default:
4874 equal_p = !NILP (Fequal (a, b));
4875 break;
4880 return equal_p;
4884 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p,
4885 Sinternal_lisp_face_equal_p, 2, 3, 0,
4886 doc: /* True if FACE1 and FACE2 are equal.
4887 If the optional argument FRAME is given, report on face FACE in that frame.
4888 If FRAME is t, report on the defaults for face FACE (for new frames).
4889 If FRAME is omitted or nil, use the selected frame. */)
4890 (face1, face2, frame)
4891 Lisp_Object face1, face2, frame;
4893 int equal_p;
4894 struct frame *f;
4895 Lisp_Object lface1, lface2;
4897 if (EQ (frame, Qt))
4898 f = NULL;
4899 else
4900 /* Don't use check_x_frame here because this function is called
4901 before X frames exist. At that time, if FRAME is nil,
4902 selected_frame will be used which is the frame dumped with
4903 Emacs. That frame is not an X frame. */
4904 f = frame_or_selected_frame (frame, 2);
4906 lface1 = lface_from_face_name (NULL, face1, 1);
4907 lface2 = lface_from_face_name (NULL, face2, 1);
4908 equal_p = lface_equal_p (XVECTOR (lface1)->contents,
4909 XVECTOR (lface2)->contents);
4910 return equal_p ? Qt : Qnil;
4914 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p,
4915 Sinternal_lisp_face_empty_p, 1, 2, 0,
4916 doc: /* True if FACE has no attribute specified.
4917 If the optional argument FRAME is given, report on face FACE in that frame.
4918 If FRAME is t, report on the defaults for face FACE (for new frames).
4919 If FRAME is omitted or nil, use the selected frame. */)
4920 (face, frame)
4921 Lisp_Object face, frame;
4923 struct frame *f;
4924 Lisp_Object lface;
4925 int i;
4927 if (NILP (frame))
4928 frame = selected_frame;
4929 CHECK_LIVE_FRAME (frame);
4930 f = XFRAME (frame);
4932 if (EQ (frame, Qt))
4933 lface = lface_from_face_name (NULL, face, 1);
4934 else
4935 lface = lface_from_face_name (f, face, 1);
4937 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
4938 if (!UNSPECIFIEDP (AREF (lface, i)))
4939 break;
4941 return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
4945 DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
4946 0, 1, 0,
4947 doc: /* Return an alist of frame-local faces defined on FRAME.
4948 For internal use only. */)
4949 (frame)
4950 Lisp_Object frame;
4952 struct frame *f = frame_or_selected_frame (frame, 0);
4953 return f->face_alist;
4957 /* Return a hash code for Lisp string STRING with case ignored. Used
4958 below in computing a hash value for a Lisp face. */
4960 static INLINE unsigned
4961 hash_string_case_insensitive (string)
4962 Lisp_Object string;
4964 const unsigned char *s;
4965 unsigned hash = 0;
4966 xassert (STRINGP (string));
4967 for (s = SDATA (string); *s; ++s)
4968 hash = (hash << 1) ^ tolower (*s);
4969 return hash;
4973 /* Return a hash code for face attribute vector V. */
4975 static INLINE unsigned
4976 lface_hash (v)
4977 Lisp_Object *v;
4979 return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
4980 ^ hash_string_case_insensitive (v[LFACE_FOREGROUND_INDEX])
4981 ^ hash_string_case_insensitive (v[LFACE_BACKGROUND_INDEX])
4982 ^ XFASTINT (v[LFACE_WEIGHT_INDEX])
4983 ^ XFASTINT (v[LFACE_SLANT_INDEX])
4984 ^ XFASTINT (v[LFACE_SWIDTH_INDEX])
4985 ^ XFASTINT (v[LFACE_HEIGHT_INDEX]));
4989 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4990 considering charsets/registries). They do if they specify the same
4991 family, point size, weight, width, slant, and fontset. Both LFACE1
4992 and LFACE2 must be fully-specified. */
4994 static INLINE int
4995 lface_same_font_attributes_p (lface1, lface2)
4996 Lisp_Object *lface1, *lface2;
4998 xassert (lface_fully_specified_p (lface1)
4999 && lface_fully_specified_p (lface2));
5000 return (xstricmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
5001 SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
5002 && EQ (lface1[LFACE_HEIGHT_INDEX], lface2[LFACE_HEIGHT_INDEX])
5003 && EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
5004 && EQ (lface1[LFACE_AVGWIDTH_INDEX], lface2[LFACE_AVGWIDTH_INDEX])
5005 && EQ (lface1[LFACE_WEIGHT_INDEX], lface2[LFACE_WEIGHT_INDEX])
5006 && EQ (lface1[LFACE_SLANT_INDEX], lface2[LFACE_SLANT_INDEX])
5007 && (EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
5008 || (STRINGP (lface1[LFACE_FONT_INDEX])
5009 && STRINGP (lface2[LFACE_FONT_INDEX])
5010 && xstricmp (SDATA (lface1[LFACE_FONT_INDEX]),
5011 SDATA (lface2[LFACE_FONT_INDEX])))));
5016 /***********************************************************************
5017 Realized Faces
5018 ***********************************************************************/
5020 /* Allocate and return a new realized face for Lisp face attribute
5021 vector ATTR. */
5023 static struct face *
5024 make_realized_face (attr)
5025 Lisp_Object *attr;
5027 struct face *face = (struct face *) xmalloc (sizeof *face);
5028 bzero (face, sizeof *face);
5029 face->ascii_face = face;
5030 bcopy (attr, face->lface, sizeof face->lface);
5031 return face;
5035 /* Free realized face FACE, including its X resources. FACE may
5036 be null. */
5038 static void
5039 free_realized_face (f, face)
5040 struct frame *f;
5041 struct face *face;
5043 if (face)
5045 #ifdef HAVE_WINDOW_SYSTEM
5046 if (FRAME_WINDOW_P (f))
5048 /* Free fontset of FACE if it is ASCII face. */
5049 if (face->fontset >= 0 && face == face->ascii_face)
5050 free_face_fontset (f, face);
5051 if (face->gc)
5053 x_free_gc (f, face->gc);
5054 face->gc = 0;
5057 free_face_colors (f, face);
5058 x_destroy_bitmap (f, face->stipple);
5060 #endif /* HAVE_WINDOW_SYSTEM */
5062 xfree (face);
5067 /* Prepare face FACE for subsequent display on frame F. This
5068 allocated GCs if they haven't been allocated yet or have been freed
5069 by clearing the face cache. */
5071 void
5072 prepare_face_for_display (f, face)
5073 struct frame *f;
5074 struct face *face;
5076 #ifdef HAVE_WINDOW_SYSTEM
5077 xassert (FRAME_WINDOW_P (f));
5079 if (face->gc == 0)
5081 XGCValues xgcv;
5082 unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures;
5084 xgcv.foreground = face->foreground;
5085 xgcv.background = face->background;
5086 #ifdef HAVE_X_WINDOWS
5087 xgcv.graphics_exposures = False;
5088 #endif
5089 /* The font of FACE may be null if we couldn't load it. */
5090 if (face->font)
5092 #ifdef HAVE_X_WINDOWS
5093 xgcv.font = face->font->fid;
5094 #endif
5095 #ifdef WINDOWSNT
5096 xgcv.font = face->font;
5097 #endif
5098 #ifdef MAC_OS
5099 xgcv.font = face->font;
5100 #endif
5101 mask |= GCFont;
5104 BLOCK_INPUT;
5105 #ifdef HAVE_X_WINDOWS
5106 if (face->stipple)
5108 xgcv.fill_style = FillOpaqueStippled;
5109 xgcv.stipple = x_bitmap_pixmap (f, face->stipple);
5110 mask |= GCFillStyle | GCStipple;
5112 #endif
5113 face->gc = x_create_gc (f, mask, &xgcv);
5114 UNBLOCK_INPUT;
5116 #endif /* HAVE_WINDOW_SYSTEM */
5120 /* Returns the `distance' between the colors X and Y. */
5122 static int
5123 color_distance (x, y)
5124 XColor *x, *y;
5126 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5127 Quoting from that paper:
5129 This formula has results that are very close to L*u*v* (with the
5130 modified lightness curve) and, more importantly, it is a more even
5131 algorithm: it does not have a range of colours where it suddenly
5132 gives far from optimal results.
5134 See <http://www.compuphase.com/cmetric.htm> for more info. */
5136 long r = (x->red - y->red) >> 8;
5137 long g = (x->green - y->green) >> 8;
5138 long b = (x->blue - y->blue) >> 8;
5139 long r_mean = (x->red + y->red) >> 9;
5141 return
5142 (((512 + r_mean) * r * r) >> 8)
5143 + 4 * g * g
5144 + (((767 - r_mean) * b * b) >> 8);
5148 DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
5149 doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5150 COLOR1 and COLOR2 may be either strings containing the color name,
5151 or lists of the form (RED GREEN BLUE).
5152 If FRAME is unspecified or nil, the current frame is used. */)
5153 (color1, color2, frame)
5154 Lisp_Object color1, color2, frame;
5156 struct frame *f;
5157 XColor cdef1, cdef2;
5159 if (NILP (frame))
5160 frame = selected_frame;
5161 CHECK_LIVE_FRAME (frame);
5162 f = XFRAME (frame);
5164 if ((CONSP (color1) && !parse_rgb_list (color1, &cdef1))
5165 || !STRINGP (color1)
5166 || !defined_color (f, SDATA (color1), &cdef1, 0))
5167 signal_error ("Invalid color", color1);
5168 if ((CONSP (color2) && !parse_rgb_list (color2, &cdef2))
5169 || !STRINGP (color2)
5170 || !defined_color (f, SDATA (color2), &cdef2, 0))
5171 signal_error ("Invalid color", color2);
5173 return make_number (color_distance (&cdef1, &cdef2));
5177 /***********************************************************************
5178 Face capability testing for ttys
5179 ***********************************************************************/
5182 /* If the distance (as returned by color_distance) between two colors is
5183 less than this, then they are considered the same, for determining
5184 whether a color is supported or not. The range of values is 0-65535. */
5186 #define TTY_SAME_COLOR_THRESHOLD 10000
5189 DEFUN ("tty-supports-face-attributes-p",
5190 Ftty_supports_face_attributes_p, Stty_supports_face_attributes_p,
5191 1, 2, 0,
5192 doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5193 The optional argument FRAME is the frame on which to test; if it is nil
5194 or unspecified, then the current frame is used. If FRAME is not a tty
5195 frame, then nil is returned.
5197 The definition of `supported' is somewhat heuristic, but basically means
5198 that a face containing all the attributes in ATTRIBUTES, when merged
5199 with the default face for display, can be represented in a way that's
5201 \(1) different in appearance than the default face, and
5202 \(2) `close in spirit' to what the attributes specify, if not exact.
5204 Point (2) implies that a `:weight black' attribute will be satisified
5205 by any terminal that can display bold, and a `:foreground "yellow"' as
5206 long as the terminal can display a yellowish color, but `:slant italic'
5207 will _not_ be satisified by the tty display code's automatic
5208 substitution of a `dim' face for italic. */)
5209 (attributes, frame)
5210 Lisp_Object attributes, frame;
5212 int weight, i;
5213 struct frame *f;
5214 Lisp_Object val, fg, bg;
5215 XColor fg_tty_color, fg_std_color;
5216 XColor bg_tty_color, bg_std_color;
5217 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5218 unsigned test_caps = 0;
5220 if (NILP (frame))
5221 frame = selected_frame;
5222 CHECK_LIVE_FRAME (frame);
5223 f = XFRAME (frame);
5225 for (i = 0; i < LFACE_VECTOR_SIZE; i++)
5226 attrs[i] = Qunspecified;
5227 merge_face_vector_with_property (f, attrs, attributes);
5229 /* This function only works on ttys. */
5230 if (!FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f))
5231 return Qnil;
5233 /* First check some easy-to-check stuff; ttys support none of the
5234 following attributes, so we can just return nil if any are requested. */
5236 /* stipple */
5237 val = attrs[LFACE_STIPPLE_INDEX];
5238 if (!UNSPECIFIEDP (val) && !NILP (val))
5239 return Qnil;
5241 /* font height */
5242 val = attrs[LFACE_HEIGHT_INDEX];
5243 if (!UNSPECIFIEDP (val) && !NILP (val))
5244 return Qnil;
5246 /* font width */
5247 val = attrs[LFACE_SWIDTH_INDEX];
5248 if (!UNSPECIFIEDP (val) && !NILP (val)
5249 && face_numeric_swidth (val) != XLFD_SWIDTH_MEDIUM)
5250 return Qnil;
5252 /* overline */
5253 val = attrs[LFACE_OVERLINE_INDEX];
5254 if (!UNSPECIFIEDP (val) && !NILP (val))
5255 return Qnil;
5257 /* strike-through */
5258 val = attrs[LFACE_STRIKE_THROUGH_INDEX];
5259 if (!UNSPECIFIEDP (val) && !NILP (val))
5260 return Qnil;
5262 /* boxes */
5263 val = attrs[LFACE_BOX_INDEX];
5264 if (!UNSPECIFIEDP (val) && !NILP (val))
5265 return Qnil;
5267 /* slant (italics/oblique); We consider any non-default value
5268 unsupportable on ttys, even though the face code actually `fakes'
5269 them using a dim attribute if possible. This is because the faked
5270 result is too different from what the face specifies. */
5271 val = attrs[LFACE_SLANT_INDEX];
5272 if (!UNSPECIFIEDP (val) && !NILP (val)
5273 && face_numeric_slant (val) != XLFD_SLANT_ROMAN)
5274 return Qnil;
5277 /* Test for terminal `capabilities' (non-color character attributes). */
5279 /* font weight (bold/dim) */
5280 weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
5281 if (weight >= 0)
5283 if (weight > XLFD_WEIGHT_MEDIUM)
5284 test_caps = TTY_CAP_BOLD;
5285 else if (weight < XLFD_WEIGHT_MEDIUM)
5286 test_caps = TTY_CAP_DIM;
5289 /* underlining */
5290 val = attrs[LFACE_UNDERLINE_INDEX];
5291 if (!UNSPECIFIEDP (val) && !NILP (val))
5293 if (STRINGP (val))
5294 return Qnil; /* ttys don't support colored underlines */
5295 else
5296 test_caps |= TTY_CAP_UNDERLINE;
5299 /* inverse video */
5300 val = attrs[LFACE_INVERSE_INDEX];
5301 if (!UNSPECIFIEDP (val) && !NILP (val))
5302 test_caps |= TTY_CAP_INVERSE;
5305 /* Color testing. */
5307 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5308 we use them when calling `tty_capable_p' below, even if the face
5309 specifies no colors. */
5310 fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
5311 bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
5313 /* Check if foreground color is close enough. */
5314 fg = attrs[LFACE_FOREGROUND_INDEX];
5315 if (STRINGP (fg))
5317 if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
5318 return Qnil;
5319 else if (color_distance (&fg_tty_color, &fg_std_color)
5320 > TTY_SAME_COLOR_THRESHOLD)
5321 return Qnil;
5324 /* Check if background color is close enough. */
5325 bg = attrs[LFACE_BACKGROUND_INDEX];
5326 if (STRINGP (bg))
5328 if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
5329 return Qnil;
5330 else if (color_distance (&bg_tty_color, &bg_std_color)
5331 > TTY_SAME_COLOR_THRESHOLD)
5332 return Qnil;
5335 /* If both foreground and background are requested, see if the
5336 distance between them is OK. We just check to see if the distance
5337 between the tty's foreground and background is close enough to the
5338 distance between the standard foreground and background. */
5339 if (STRINGP (fg) && STRINGP (bg))
5341 int delta_delta
5342 = (color_distance (&fg_std_color, &bg_std_color)
5343 - color_distance (&fg_tty_color, &bg_tty_color));
5344 if (delta_delta > TTY_SAME_COLOR_THRESHOLD
5345 || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
5346 return Qnil;
5350 /* See if the capabilities we selected above are supported, with the
5351 given colors. */
5352 if (test_caps != 0 &&
5353 ! tty_capable_p (f, test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
5354 return Qnil;
5357 /* Hmmm, everything checks out, this terminal must support this face. */
5358 return Qt;
5363 /***********************************************************************
5364 Face Cache
5365 ***********************************************************************/
5367 /* Return a new face cache for frame F. */
5369 static struct face_cache *
5370 make_face_cache (f)
5371 struct frame *f;
5373 struct face_cache *c;
5374 int size;
5376 c = (struct face_cache *) xmalloc (sizeof *c);
5377 bzero (c, sizeof *c);
5378 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5379 c->buckets = (struct face **) xmalloc (size);
5380 bzero (c->buckets, size);
5381 c->size = 50;
5382 c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id);
5383 c->f = f;
5384 c->menu_face_changed_p = menu_face_changed_default;
5385 return c;
5389 /* Clear out all graphics contexts for all realized faces, except for
5390 the basic faces. This should be done from time to time just to avoid
5391 keeping too many graphics contexts that are no longer needed. */
5393 static void
5394 clear_face_gcs (c)
5395 struct face_cache *c;
5397 if (c && FRAME_WINDOW_P (c->f))
5399 #ifdef HAVE_WINDOW_SYSTEM
5400 int i;
5401 for (i = BASIC_FACE_ID_SENTINEL; i < c->used; ++i)
5403 struct face *face = c->faces_by_id[i];
5404 if (face && face->gc)
5406 x_free_gc (c->f, face->gc);
5407 face->gc = 0;
5410 #endif /* HAVE_WINDOW_SYSTEM */
5415 /* Free all realized faces in face cache C, including basic faces. C
5416 may be null. If faces are freed, make sure the frame's current
5417 matrix is marked invalid, so that a display caused by an expose
5418 event doesn't try to use faces we destroyed. */
5420 static void
5421 free_realized_faces (c)
5422 struct face_cache *c;
5424 if (c && c->used)
5426 int i, size;
5427 struct frame *f = c->f;
5429 /* We must block input here because we can't process X events
5430 safely while only some faces are freed, or when the frame's
5431 current matrix still references freed faces. */
5432 BLOCK_INPUT;
5434 for (i = 0; i < c->used; ++i)
5436 free_realized_face (f, c->faces_by_id[i]);
5437 c->faces_by_id[i] = NULL;
5440 c->used = 0;
5441 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5442 bzero (c->buckets, size);
5444 /* Must do a thorough redisplay the next time. Mark current
5445 matrices as invalid because they will reference faces freed
5446 above. This function is also called when a frame is
5447 destroyed. In this case, the root window of F is nil. */
5448 if (WINDOWP (f->root_window))
5450 clear_current_matrices (f);
5451 ++windows_or_buffers_changed;
5454 UNBLOCK_INPUT;
5459 /* Free all faces realized for multibyte characters on frame F that
5460 has FONTSET. */
5462 void
5463 free_realized_multibyte_face (f, fontset)
5464 struct frame *f;
5465 int fontset;
5467 struct face_cache *cache = FRAME_FACE_CACHE (f);
5468 struct face *face;
5469 int i;
5471 /* We must block input here because we can't process X events safely
5472 while only some faces are freed, or when the frame's current
5473 matrix still references freed faces. */
5474 BLOCK_INPUT;
5476 for (i = 0; i < cache->used; i++)
5478 face = cache->faces_by_id[i];
5479 if (face
5480 && face != face->ascii_face
5481 && face->fontset == fontset)
5483 uncache_face (cache, face);
5484 free_realized_face (f, face);
5488 /* Must do a thorough redisplay the next time. Mark current
5489 matrices as invalid because they will reference faces freed
5490 above. This function is also called when a frame is destroyed.
5491 In this case, the root window of F is nil. */
5492 if (WINDOWP (f->root_window))
5494 clear_current_matrices (f);
5495 ++windows_or_buffers_changed;
5498 UNBLOCK_INPUT;
5502 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5503 This is done after attributes of a named face have been changed,
5504 because we can't tell which realized faces depend on that face. */
5506 void
5507 free_all_realized_faces (frame)
5508 Lisp_Object frame;
5510 if (NILP (frame))
5512 Lisp_Object rest;
5513 FOR_EACH_FRAME (rest, frame)
5514 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
5516 else
5517 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
5521 /* Free face cache C and faces in it, including their X resources. */
5523 static void
5524 free_face_cache (c)
5525 struct face_cache *c;
5527 if (c)
5529 free_realized_faces (c);
5530 xfree (c->buckets);
5531 xfree (c->faces_by_id);
5532 xfree (c);
5537 /* Cache realized face FACE in face cache C. HASH is the hash value
5538 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5539 collision list of the face hash table of C. This is done because
5540 otherwise lookup_face would find FACE for every character, even if
5541 faces with the same attributes but for specific characters exist. */
5543 static void
5544 cache_face (c, face, hash)
5545 struct face_cache *c;
5546 struct face *face;
5547 unsigned hash;
5549 int i = hash % FACE_CACHE_BUCKETS_SIZE;
5551 face->hash = hash;
5553 if (face->fontset >= 0)
5555 struct face *last = c->buckets[i];
5556 if (last)
5558 while (last->next)
5559 last = last->next;
5560 last->next = face;
5561 face->prev = last;
5562 face->next = NULL;
5564 else
5566 c->buckets[i] = face;
5567 face->prev = face->next = NULL;
5570 else
5572 face->prev = NULL;
5573 face->next = c->buckets[i];
5574 if (face->next)
5575 face->next->prev = face;
5576 c->buckets[i] = face;
5579 /* Find a free slot in C->faces_by_id and use the index of the free
5580 slot as FACE->id. */
5581 for (i = 0; i < c->used; ++i)
5582 if (c->faces_by_id[i] == NULL)
5583 break;
5584 face->id = i;
5586 /* Maybe enlarge C->faces_by_id. */
5587 if (i == c->used && c->used == c->size)
5589 int new_size = 2 * c->size;
5590 int sz = new_size * sizeof *c->faces_by_id;
5591 c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
5592 c->size = new_size;
5595 #if GLYPH_DEBUG
5596 /* Check that FACE got a unique id. */
5598 int j, n;
5599 struct face *face;
5601 for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j)
5602 for (face = c->buckets[j]; face; face = face->next)
5603 if (face->id == i)
5604 ++n;
5606 xassert (n == 1);
5608 #endif /* GLYPH_DEBUG */
5610 c->faces_by_id[i] = face;
5611 if (i == c->used)
5612 ++c->used;
5616 /* Remove face FACE from cache C. */
5618 static void
5619 uncache_face (c, face)
5620 struct face_cache *c;
5621 struct face *face;
5623 int i = face->hash % FACE_CACHE_BUCKETS_SIZE;
5625 if (face->prev)
5626 face->prev->next = face->next;
5627 else
5628 c->buckets[i] = face->next;
5630 if (face->next)
5631 face->next->prev = face->prev;
5633 c->faces_by_id[face->id] = NULL;
5634 if (face->id == c->used)
5635 --c->used;
5639 /* Look up a realized face with face attributes ATTR in the face cache
5640 of frame F. The face will be used to display character C. Value
5641 is the ID of the face found. If no suitable face is found, realize
5642 a new one. In that case, if C is a multibyte character, BASE_FACE
5643 is a face that has the same attributes. */
5645 INLINE int
5646 lookup_face (f, attr, c, base_face)
5647 struct frame *f;
5648 Lisp_Object *attr;
5649 int c;
5650 struct face *base_face;
5652 struct face_cache *cache = FRAME_FACE_CACHE (f);
5653 unsigned hash;
5654 int i;
5655 struct face *face;
5657 xassert (cache != NULL);
5658 check_lface_attrs (attr);
5660 /* Look up ATTR in the face cache. */
5661 hash = lface_hash (attr);
5662 i = hash % FACE_CACHE_BUCKETS_SIZE;
5664 for (face = cache->buckets[i]; face; face = face->next)
5665 if (face->hash == hash
5666 && (!FRAME_WINDOW_P (f)
5667 || FACE_SUITABLE_FOR_CHAR_P (face, c))
5668 && lface_equal_p (face->lface, attr))
5669 break;
5671 /* If not found, realize a new face. */
5672 if (face == NULL)
5673 face = realize_face (cache, attr, c, base_face, -1);
5675 #if GLYPH_DEBUG
5676 xassert (face == FACE_FROM_ID (f, face->id));
5678 /* When this function is called from face_for_char (in this case, C is
5679 a multibyte character), a fontset of a face returned by
5680 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5681 C) is not sutisfied. The fontset is set for this face by
5682 face_for_char later. */
5683 #if 0
5684 if (FRAME_WINDOW_P (f))
5685 xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
5686 #endif
5687 #endif /* GLYPH_DEBUG */
5689 return face->id;
5693 /* Return the face id of the realized face for named face SYMBOL on
5694 frame F suitable for displaying character C. Value is -1 if the
5695 face couldn't be determined, which might happen if the default face
5696 isn't realized and cannot be realized. */
5699 lookup_named_face (f, symbol, c)
5700 struct frame *f;
5701 Lisp_Object symbol;
5702 int c;
5704 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5705 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
5706 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5708 if (default_face == NULL)
5710 if (!realize_basic_faces (f))
5711 return -1;
5712 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5715 get_lface_attributes (f, symbol, symbol_attrs, 1);
5716 bcopy (default_face->lface, attrs, sizeof attrs);
5717 merge_face_vectors (f, symbol_attrs, attrs, Qnil);
5718 return lookup_face (f, attrs, c, NULL);
5722 /* Return the ID of the realized ASCII face of Lisp face with ID
5723 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5726 ascii_face_of_lisp_face (f, lface_id)
5727 struct frame *f;
5728 int lface_id;
5730 int face_id;
5732 if (lface_id >= 0 && lface_id < lface_id_to_name_size)
5734 Lisp_Object face_name = lface_id_to_name[lface_id];
5735 face_id = lookup_named_face (f, face_name, 0);
5737 else
5738 face_id = -1;
5740 return face_id;
5744 /* Return a face for charset ASCII that is like the face with id
5745 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5746 STEPS < 0 means larger. Value is the id of the face. */
5749 smaller_face (f, face_id, steps)
5750 struct frame *f;
5751 int face_id, steps;
5753 #ifdef HAVE_WINDOW_SYSTEM
5754 struct face *face;
5755 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5756 int pt, last_pt, last_height;
5757 int delta;
5758 int new_face_id;
5759 struct face *new_face;
5761 /* If not called for an X frame, just return the original face. */
5762 if (FRAME_TERMCAP_P (f))
5763 return face_id;
5765 /* Try in increments of 1/2 pt. */
5766 delta = steps < 0 ? 5 : -5;
5767 steps = abs (steps);
5769 face = FACE_FROM_ID (f, face_id);
5770 bcopy (face->lface, attrs, sizeof attrs);
5771 pt = last_pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
5772 new_face_id = face_id;
5773 last_height = FONT_HEIGHT (face->font);
5775 while (steps
5776 && pt + delta > 0
5777 /* Give up if we cannot find a font within 10pt. */
5778 && abs (last_pt - pt) < 100)
5780 /* Look up a face for a slightly smaller/larger font. */
5781 pt += delta;
5782 attrs[LFACE_HEIGHT_INDEX] = make_number (pt);
5783 new_face_id = lookup_face (f, attrs, 0, NULL);
5784 new_face = FACE_FROM_ID (f, new_face_id);
5786 /* If height changes, count that as one step. */
5787 if ((delta < 0 && FONT_HEIGHT (new_face->font) < last_height)
5788 || (delta > 0 && FONT_HEIGHT (new_face->font) > last_height))
5790 --steps;
5791 last_height = FONT_HEIGHT (new_face->font);
5792 last_pt = pt;
5796 return new_face_id;
5798 #else /* not HAVE_WINDOW_SYSTEM */
5800 return face_id;
5802 #endif /* not HAVE_WINDOW_SYSTEM */
5806 /* Return a face for charset ASCII that is like the face with id
5807 FACE_ID on frame F, but has height HEIGHT. */
5810 face_with_height (f, face_id, height)
5811 struct frame *f;
5812 int face_id;
5813 int height;
5815 #ifdef HAVE_WINDOW_SYSTEM
5816 struct face *face;
5817 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5819 if (FRAME_TERMCAP_P (f)
5820 || height <= 0)
5821 return face_id;
5823 face = FACE_FROM_ID (f, face_id);
5824 bcopy (face->lface, attrs, sizeof attrs);
5825 attrs[LFACE_HEIGHT_INDEX] = make_number (height);
5826 face_id = lookup_face (f, attrs, 0, NULL);
5827 #endif /* HAVE_WINDOW_SYSTEM */
5829 return face_id;
5833 /* Return the face id of the realized face for named face SYMBOL on
5834 frame F suitable for displaying character C, and use attributes of
5835 the face FACE_ID for attributes that aren't completely specified by
5836 SYMBOL. This is like lookup_named_face, except that the default
5837 attributes come from FACE_ID, not from the default face. FACE_ID
5838 is assumed to be already realized. */
5841 lookup_derived_face (f, symbol, c, face_id)
5842 struct frame *f;
5843 Lisp_Object symbol;
5844 int c;
5845 int face_id;
5847 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5848 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
5849 struct face *default_face = FACE_FROM_ID (f, face_id);
5851 if (!default_face)
5852 abort ();
5854 get_lface_attributes (f, symbol, symbol_attrs, 1);
5855 bcopy (default_face->lface, attrs, sizeof attrs);
5856 merge_face_vectors (f, symbol_attrs, attrs, Qnil);
5857 return lookup_face (f, attrs, c, default_face);
5860 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
5861 Sface_attributes_as_vector, 1, 1, 0,
5862 doc: /* Return a vector of face attributes corresponding to PLIST. */)
5863 (plist)
5864 Lisp_Object plist;
5866 Lisp_Object lface;
5867 lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
5868 Qunspecified);
5869 merge_face_vector_with_property (XFRAME (selected_frame),
5870 XVECTOR (lface)->contents,
5871 plist);
5872 return lface;
5877 /***********************************************************************
5878 Font selection
5879 ***********************************************************************/
5881 DEFUN ("internal-set-font-selection-order",
5882 Finternal_set_font_selection_order,
5883 Sinternal_set_font_selection_order, 1, 1, 0,
5884 doc: /* Set font selection order for face font selection to ORDER.
5885 ORDER must be a list of length 4 containing the symbols `:width',
5886 `:height', `:weight', and `:slant'. Face attributes appearing
5887 first in ORDER are matched first, e.g. if `:height' appears before
5888 `:weight' in ORDER, font selection first tries to find a font with
5889 a suitable height, and then tries to match the font weight.
5890 Value is ORDER. */)
5891 (order)
5892 Lisp_Object order;
5894 Lisp_Object list;
5895 int i;
5896 int indices[DIM (font_sort_order)];
5898 CHECK_LIST (order);
5899 bzero (indices, sizeof indices);
5900 i = 0;
5902 for (list = order;
5903 CONSP (list) && i < DIM (indices);
5904 list = XCDR (list), ++i)
5906 Lisp_Object attr = XCAR (list);
5907 int xlfd;
5909 if (EQ (attr, QCwidth))
5910 xlfd = XLFD_SWIDTH;
5911 else if (EQ (attr, QCheight))
5912 xlfd = XLFD_POINT_SIZE;
5913 else if (EQ (attr, QCweight))
5914 xlfd = XLFD_WEIGHT;
5915 else if (EQ (attr, QCslant))
5916 xlfd = XLFD_SLANT;
5917 else
5918 break;
5920 if (indices[i] != 0)
5921 break;
5922 indices[i] = xlfd;
5925 if (!NILP (list) || i != DIM (indices))
5926 signal_error ("Invalid font sort order", order);
5927 for (i = 0; i < DIM (font_sort_order); ++i)
5928 if (indices[i] == 0)
5929 signal_error ("Invalid font sort order", order);
5931 if (bcmp (indices, font_sort_order, sizeof indices) != 0)
5933 bcopy (indices, font_sort_order, sizeof font_sort_order);
5934 free_all_realized_faces (Qnil);
5937 return Qnil;
5941 DEFUN ("internal-set-alternative-font-family-alist",
5942 Finternal_set_alternative_font_family_alist,
5943 Sinternal_set_alternative_font_family_alist, 1, 1, 0,
5944 doc: /* Define alternative font families to try in face font selection.
5945 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5946 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5947 be found. Value is ALIST. */)
5948 (alist)
5949 Lisp_Object alist;
5951 CHECK_LIST (alist);
5952 Vface_alternative_font_family_alist = alist;
5953 free_all_realized_faces (Qnil);
5954 return alist;
5958 DEFUN ("internal-set-alternative-font-registry-alist",
5959 Finternal_set_alternative_font_registry_alist,
5960 Sinternal_set_alternative_font_registry_alist, 1, 1, 0,
5961 doc: /* Define alternative font registries to try in face font selection.
5962 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5963 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5964 be found. Value is ALIST. */)
5965 (alist)
5966 Lisp_Object alist;
5968 CHECK_LIST (alist);
5969 Vface_alternative_font_registry_alist = alist;
5970 free_all_realized_faces (Qnil);
5971 return alist;
5975 #ifdef HAVE_WINDOW_SYSTEM
5977 /* Value is non-zero if FONT is the name of a scalable font. The
5978 X11R6 XLFD spec says that point size, pixel size, and average width
5979 are zero for scalable fonts. Intlfonts contain at least one
5980 scalable font ("*-muleindian-1") for which this isn't true, so we
5981 just test average width. */
5983 static int
5984 font_scalable_p (font)
5985 struct font_name *font;
5987 char *s = font->fields[XLFD_AVGWIDTH];
5988 return (*s == '0' && *(s + 1) == '\0')
5989 #ifdef WINDOWSNT
5990 /* Windows implementation of XLFD is slightly broken for backward
5991 compatibility with previous broken versions, so test for
5992 wildcards as well as 0. */
5993 || *s == '*'
5994 #endif
5999 /* Ignore the difference of font point size less than this value. */
6001 #define FONT_POINT_SIZE_QUANTUM 5
6003 /* Value is non-zero if FONT1 is a better match for font attributes
6004 VALUES than FONT2. VALUES is an array of face attribute values in
6005 font sort order. COMPARE_PT_P zero means don't compare point
6006 sizes. AVGWIDTH, if not zero, is a specified font average width
6007 to compare with. */
6009 static int
6010 better_font_p (values, font1, font2, compare_pt_p, avgwidth)
6011 int *values;
6012 struct font_name *font1, *font2;
6013 int compare_pt_p, avgwidth;
6015 int i;
6017 for (i = 0; i < DIM (font_sort_order); ++i)
6019 int xlfd_idx = font_sort_order[i];
6021 if (compare_pt_p || xlfd_idx != XLFD_POINT_SIZE)
6023 int delta1, delta2;
6025 if (xlfd_idx == XLFD_POINT_SIZE)
6027 delta1 = abs (values[i] - (font1->numeric[xlfd_idx]
6028 / font1->rescale_ratio));
6029 delta2 = abs (values[i] - (font2->numeric[xlfd_idx]
6030 / font2->rescale_ratio));
6031 if (abs (delta1 - delta2) < FONT_POINT_SIZE_QUANTUM)
6032 continue;
6034 else
6036 delta1 = abs (values[i] - font1->numeric[xlfd_idx]);
6037 delta2 = abs (values[i] - font2->numeric[xlfd_idx]);
6040 if (delta1 > delta2)
6041 return 0;
6042 else if (delta1 < delta2)
6043 return 1;
6044 else
6046 /* The difference may be equal because, e.g., the face
6047 specifies `italic' but we have only `regular' and
6048 `oblique'. Prefer `oblique' in this case. */
6049 if ((xlfd_idx == XLFD_WEIGHT || xlfd_idx == XLFD_SLANT)
6050 && font1->numeric[xlfd_idx] > values[i]
6051 && font2->numeric[xlfd_idx] < values[i])
6052 return 1;
6057 if (avgwidth)
6059 int delta1 = abs (avgwidth - font1->numeric[XLFD_AVGWIDTH]);
6060 int delta2 = abs (avgwidth - font2->numeric[XLFD_AVGWIDTH]);
6061 if (delta1 > delta2)
6062 return 0;
6063 else if (delta1 < delta2)
6064 return 1;
6067 return font1->registry_priority < font2->registry_priority;
6071 /* Value is non-zero if FONT is an exact match for face attributes in
6072 SPECIFIED. SPECIFIED is an array of face attribute values in font
6073 sort order. AVGWIDTH, if non-zero, is an average width to compare
6074 with. */
6076 static int
6077 exact_face_match_p (specified, font, avgwidth)
6078 int *specified;
6079 struct font_name *font;
6080 int avgwidth;
6082 int i;
6084 for (i = 0; i < DIM (font_sort_order); ++i)
6085 if (specified[i] != font->numeric[font_sort_order[i]])
6086 break;
6088 return (i == DIM (font_sort_order)
6089 && (avgwidth <= 0
6090 || avgwidth == font->numeric[XLFD_AVGWIDTH]));
6094 /* Value is the name of a scaled font, generated from scalable font
6095 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6096 Value is allocated from heap. */
6098 static char *
6099 build_scalable_font_name (f, font, specified_pt)
6100 struct frame *f;
6101 struct font_name *font;
6102 int specified_pt;
6104 char point_size[20], pixel_size[20];
6105 int pixel_value;
6106 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
6107 double pt;
6109 /* If scalable font is for a specific resolution, compute
6110 the point size we must specify from the resolution of
6111 the display and the specified resolution of the font. */
6112 if (font->numeric[XLFD_RESY] != 0)
6114 pt = resy / font->numeric[XLFD_RESY] * specified_pt + 0.5;
6115 pixel_value = font->numeric[XLFD_RESY] / (PT_PER_INCH * 10.0) * pt;
6117 else
6119 pt = specified_pt;
6120 pixel_value = resy / (PT_PER_INCH * 10.0) * pt;
6122 /* We may need a font of the different size. */
6123 pixel_value *= font->rescale_ratio;
6125 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6126 font of the specified PIXEL_SIZE. */
6127 #if 0
6128 /* Set point size of the font. */
6129 sprintf (point_size, "%d", (int) pt);
6130 font->fields[XLFD_POINT_SIZE] = point_size;
6131 font->numeric[XLFD_POINT_SIZE] = pt;
6132 #endif
6134 /* Set pixel size. */
6135 sprintf (pixel_size, "%d", pixel_value);
6136 font->fields[XLFD_PIXEL_SIZE] = pixel_size;
6137 font->numeric[XLFD_PIXEL_SIZE] = pixel_value;
6139 /* If font doesn't specify its resolution, use the
6140 resolution of the display. */
6141 if (font->numeric[XLFD_RESY] == 0)
6143 char buffer[20];
6144 sprintf (buffer, "%d", (int) resy);
6145 font->fields[XLFD_RESY] = buffer;
6146 font->numeric[XLFD_RESY] = resy;
6149 if (strcmp (font->fields[XLFD_RESX], "0") == 0)
6151 char buffer[20];
6152 int resx = FRAME_X_DISPLAY_INFO (f)->resx;
6153 sprintf (buffer, "%d", resx);
6154 font->fields[XLFD_RESX] = buffer;
6155 font->numeric[XLFD_RESX] = resx;
6158 return build_font_name (font);
6162 /* Value is non-zero if we are allowed to use scalable font FONT. We
6163 can't run a Lisp function here since this function may be called
6164 with input blocked. */
6166 static int
6167 may_use_scalable_font_p (font)
6168 const char *font;
6170 if (EQ (Vscalable_fonts_allowed, Qt))
6171 return 1;
6172 else if (CONSP (Vscalable_fonts_allowed))
6174 Lisp_Object tail, regexp;
6176 for (tail = Vscalable_fonts_allowed; CONSP (tail); tail = XCDR (tail))
6178 regexp = XCAR (tail);
6179 if (STRINGP (regexp)
6180 && fast_c_string_match_ignore_case (regexp, font) >= 0)
6181 return 1;
6185 return 0;
6190 /* Return the name of the best matching font for face attributes ATTRS
6191 in the array of font_name structures FONTS which contains NFONTS
6192 elements. WIDTH_RATIO is a factor with which to multiply average
6193 widths if ATTRS specifies such a width.
6195 Value is a font name which is allocated from the heap. FONTS is
6196 freed by this function.
6198 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6199 indicate whether the resulting font should be drawn using overstrike
6200 to simulate bold-face. */
6202 static char *
6203 best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike)
6204 struct frame *f;
6205 Lisp_Object *attrs;
6206 struct font_name *fonts;
6207 int nfonts;
6208 int width_ratio;
6209 int *needs_overstrike;
6211 char *font_name;
6212 struct font_name *best;
6213 int i, pt = 0;
6214 int specified[5];
6215 int exact_p, avgwidth;
6217 if (nfonts == 0)
6218 return NULL;
6220 /* Make specified font attributes available in `specified',
6221 indexed by sort order. */
6222 for (i = 0; i < DIM (font_sort_order); ++i)
6224 int xlfd_idx = font_sort_order[i];
6226 if (xlfd_idx == XLFD_SWIDTH)
6227 specified[i] = face_numeric_swidth (attrs[LFACE_SWIDTH_INDEX]);
6228 else if (xlfd_idx == XLFD_POINT_SIZE)
6229 specified[i] = pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
6230 else if (xlfd_idx == XLFD_WEIGHT)
6231 specified[i] = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
6232 else if (xlfd_idx == XLFD_SLANT)
6233 specified[i] = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
6234 else
6235 abort ();
6238 avgwidth = (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])
6240 : XFASTINT (attrs[LFACE_AVGWIDTH_INDEX]) * width_ratio);
6242 exact_p = 0;
6244 if (needs_overstrike)
6245 *needs_overstrike = 0;
6247 /* Start with the first non-scalable font in the list. */
6248 for (i = 0; i < nfonts; ++i)
6249 if (!font_scalable_p (fonts + i))
6250 break;
6252 /* Find the best match among the non-scalable fonts. */
6253 if (i < nfonts)
6255 best = fonts + i;
6257 for (i = 1; i < nfonts; ++i)
6258 if (!font_scalable_p (fonts + i)
6259 && better_font_p (specified, fonts + i, best, 1, avgwidth))
6261 best = fonts + i;
6263 exact_p = exact_face_match_p (specified, best, avgwidth);
6264 if (exact_p)
6265 break;
6268 else
6269 best = NULL;
6271 /* Unless we found an exact match among non-scalable fonts, see if
6272 we can find a better match among scalable fonts. */
6273 if (!exact_p)
6275 /* A scalable font is better if
6277 1. its weight, slant, swidth attributes are better, or.
6279 2. the best non-scalable font doesn't have the required
6280 point size, and the scalable fonts weight, slant, swidth
6281 isn't worse. */
6283 int non_scalable_has_exact_height_p;
6285 if (best && best->numeric[XLFD_POINT_SIZE] == pt)
6286 non_scalable_has_exact_height_p = 1;
6287 else
6288 non_scalable_has_exact_height_p = 0;
6290 for (i = 0; i < nfonts; ++i)
6291 if (font_scalable_p (fonts + i))
6293 if (best == NULL
6294 || better_font_p (specified, fonts + i, best, 0, 0)
6295 || (!non_scalable_has_exact_height_p
6296 && !better_font_p (specified, best, fonts + i, 0, 0)))
6297 best = fonts + i;
6300 if (needs_overstrike)
6302 enum xlfd_weight want_weight = specified[XLFD_WEIGHT];
6303 enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT];
6305 if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight)
6307 /* We want a bold font, but didn't get one; try to use
6308 overstriking instead to simulate bold-face. However,
6309 don't overstrike an already-bold fontn unless the
6310 desired weight grossly exceeds the available weight. */
6311 if (got_weight > XLFD_WEIGHT_MEDIUM)
6312 *needs_overstrike = (got_weight - want_weight) > 2;
6313 else
6314 *needs_overstrike = 1;
6319 if (font_scalable_p (best))
6320 font_name = build_scalable_font_name (f, best, pt);
6321 else
6322 font_name = build_font_name (best);
6324 /* Free font_name structures. */
6325 free_font_names (fonts, nfonts);
6327 return font_name;
6331 /* Get a list of matching fonts on frame F, considering FAMILY
6332 and alternative font families from Vface_alternative_font_registry_alist.
6334 FAMILY is the font family whose alternatives are considered.
6336 REGISTRY, if a string, specifies a font registry and encoding to
6337 match. A value of nil means include fonts of any registry and
6338 encoding.
6340 Return in *FONTS a pointer to a vector of font_name structures for
6341 the fonts matched. Value is the number of fonts found. */
6343 static int
6344 try_alternative_families (f, family, registry, fonts)
6345 struct frame *f;
6346 Lisp_Object family, registry;
6347 struct font_name **fonts;
6349 Lisp_Object alter;
6350 int nfonts = 0;
6352 nfonts = font_list (f, Qnil, family, registry, fonts);
6353 if (nfonts == 0)
6355 /* Try alternative font families. */
6356 alter = Fassoc (family, Vface_alternative_font_family_alist);
6357 if (CONSP (alter))
6359 for (alter = XCDR (alter);
6360 CONSP (alter) && nfonts == 0;
6361 alter = XCDR (alter))
6363 if (STRINGP (XCAR (alter)))
6364 nfonts = font_list (f, Qnil, XCAR (alter), registry, fonts);
6368 /* Try all scalable fonts before giving up. */
6369 if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
6371 int count = SPECPDL_INDEX ();
6372 specbind (Qscalable_fonts_allowed, Qt);
6373 nfonts = try_alternative_families (f, family, registry, fonts);
6374 unbind_to (count, Qnil);
6377 return nfonts;
6381 /* Get a list of matching fonts on frame F.
6383 FAMILY, if a string, specifies a font family derived from the fontset.
6384 It is only used if the face does not specify any family in ATTRS or
6385 if we cannot find any font of the face's family.
6387 REGISTRY, if a string, specifies a font registry and encoding to
6388 match. A value of nil means include fonts of any registry and
6389 encoding.
6391 If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
6392 Otherwise, prefer FAMILY.
6394 Return in *FONTS a pointer to a vector of font_name structures for
6395 the fonts matched. Value is the number of fonts found. */
6397 static int
6398 try_font_list (f, attrs, family, registry, fonts, prefer_face_family)
6399 struct frame *f;
6400 Lisp_Object *attrs;
6401 Lisp_Object family, registry;
6402 struct font_name **fonts;
6403 int prefer_face_family;
6405 int nfonts = 0;
6406 Lisp_Object face_family = attrs[LFACE_FAMILY_INDEX];
6407 Lisp_Object try_family;
6409 try_family = (prefer_face_family || NILP (family)) ? face_family : family;
6411 if (STRINGP (try_family))
6412 nfonts = try_alternative_families (f, try_family, registry, fonts);
6414 #ifdef MAC_OS
6415 /* When realizing the default face and a font spec does not matched
6416 exactly, Emacs looks for ones with the same registry as the
6417 default font. On the Mac, this is mac-roman, which does not work
6418 if the family is -etl-fixed, e.g. The following widens the
6419 choices and fixes that problem. */
6420 if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry)
6421 && xstricmp (SDATA (registry), "mac-roman") == 0)
6422 nfonts = try_alternative_families (f, try_family, Qnil, fonts);
6423 #endif
6425 if (EQ (try_family, family))
6426 family = face_family;
6428 if (nfonts == 0 && STRINGP (family))
6429 nfonts = try_alternative_families (f, family, registry, fonts);
6431 /* Try font family of the default face or "fixed". */
6432 if (nfonts == 0)
6434 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6435 if (default_face)
6436 family = default_face->lface[LFACE_FAMILY_INDEX];
6437 else
6438 family = build_string ("fixed");
6439 nfonts = font_list (f, Qnil, family, registry, fonts);
6442 /* Try any family with the given registry. */
6443 if (nfonts == 0)
6444 nfonts = font_list (f, Qnil, Qnil, registry, fonts);
6446 return nfonts;
6450 /* Return the fontset id of the base fontset name or alias name given
6451 by the fontset attribute of ATTRS. Value is -1 if the fontset
6452 attribute of ATTRS doesn't name a fontset. */
6454 static int
6455 face_fontset (attrs)
6456 Lisp_Object *attrs;
6458 Lisp_Object name;
6460 name = attrs[LFACE_FONT_INDEX];
6461 if (!STRINGP (name))
6462 return -1;
6463 return fs_query_fontset (name, 0);
6467 /* Choose a name of font to use on frame F to display character C with
6468 Lisp face attributes specified by ATTRS. The font name is
6469 determined by the font-related attributes in ATTRS and the name
6470 pattern for C in FONTSET. Value is the font name which is
6471 allocated from the heap and must be freed by the caller, or NULL if
6472 we can get no information about the font name of C. It is assured
6473 that we always get some information for a single byte
6474 character.
6476 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6477 indicate whether the resulting font should be drawn using overstrike
6478 to simulate bold-face. */
6480 static char *
6481 choose_face_font (f, attrs, fontset, c, needs_overstrike)
6482 struct frame *f;
6483 Lisp_Object *attrs;
6484 int fontset, c;
6485 int *needs_overstrike;
6487 Lisp_Object pattern;
6488 char *font_name = NULL;
6489 struct font_name *fonts;
6490 int nfonts, width_ratio;
6492 if (needs_overstrike)
6493 *needs_overstrike = 0;
6495 /* Get (foundry and) family name and registry (and encoding) name of
6496 a font for C. */
6497 pattern = fontset_font_pattern (f, fontset, c);
6498 if (NILP (pattern))
6500 xassert (!SINGLE_BYTE_CHAR_P (c));
6501 return NULL;
6504 /* If what we got is a name pattern, return it. */
6505 if (STRINGP (pattern))
6506 return xstrdup (SDATA (pattern));
6508 /* Get a list of fonts matching that pattern and choose the
6509 best match for the specified face attributes from it. */
6510 nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts,
6511 (SINGLE_BYTE_CHAR_P (c)
6512 || CHAR_CHARSET (c) == charset_latin_iso8859_1));
6513 width_ratio = (SINGLE_BYTE_CHAR_P (c)
6515 : CHARSET_WIDTH (CHAR_CHARSET (c)));
6516 font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio,
6517 needs_overstrike);
6518 return font_name;
6521 #endif /* HAVE_WINDOW_SYSTEM */
6525 /***********************************************************************
6526 Face Realization
6527 ***********************************************************************/
6529 /* Realize basic faces on frame F. Value is zero if frame parameters
6530 of F don't contain enough information needed to realize the default
6531 face. */
6533 static int
6534 realize_basic_faces (f)
6535 struct frame *f;
6537 int success_p = 0;
6538 int count = SPECPDL_INDEX ();
6540 /* Block input here so that we won't be surprised by an X expose
6541 event, for instance, without having the faces set up. */
6542 BLOCK_INPUT;
6543 specbind (Qscalable_fonts_allowed, Qt);
6545 if (realize_default_face (f))
6547 realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID);
6548 realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID);
6549 realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID);
6550 realize_named_face (f, Qfringe, FRINGE_FACE_ID);
6551 realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID);
6552 realize_named_face (f, Qscroll_bar, SCROLL_BAR_FACE_ID);
6553 realize_named_face (f, Qborder, BORDER_FACE_ID);
6554 realize_named_face (f, Qcursor, CURSOR_FACE_ID);
6555 realize_named_face (f, Qmouse, MOUSE_FACE_ID);
6556 realize_named_face (f, Qmenu, MENU_FACE_ID);
6558 /* Reflect changes in the `menu' face in menu bars. */
6559 if (FRAME_FACE_CACHE (f)->menu_face_changed_p)
6561 FRAME_FACE_CACHE (f)->menu_face_changed_p = 0;
6562 #ifdef USE_X_TOOLKIT
6563 x_update_menu_appearance (f);
6564 #endif
6567 success_p = 1;
6570 unbind_to (count, Qnil);
6571 UNBLOCK_INPUT;
6572 return success_p;
6576 /* Realize the default face on frame F. If the face is not fully
6577 specified, make it fully-specified. Attributes of the default face
6578 that are not explicitly specified are taken from frame parameters. */
6580 static int
6581 realize_default_face (f)
6582 struct frame *f;
6584 struct face_cache *c = FRAME_FACE_CACHE (f);
6585 Lisp_Object lface;
6586 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6587 Lisp_Object frame_font;
6588 struct face *face;
6590 /* If the `default' face is not yet known, create it. */
6591 lface = lface_from_face_name (f, Qdefault, 0);
6592 if (NILP (lface))
6594 Lisp_Object frame;
6595 XSETFRAME (frame, f);
6596 lface = Finternal_make_lisp_face (Qdefault, frame);
6599 #ifdef HAVE_WINDOW_SYSTEM
6600 if (FRAME_WINDOW_P (f))
6602 /* Set frame_font to the value of the `font' frame parameter. */
6603 frame_font = Fassq (Qfont, f->param_alist);
6604 xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font)));
6605 frame_font = XCDR (frame_font);
6606 set_lface_from_font_name (f, lface, frame_font, 1, 1);
6608 #endif /* HAVE_WINDOW_SYSTEM */
6610 if (!FRAME_WINDOW_P (f))
6612 LFACE_FAMILY (lface) = build_string ("default");
6613 LFACE_SWIDTH (lface) = Qnormal;
6614 LFACE_HEIGHT (lface) = make_number (1);
6615 if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
6616 LFACE_WEIGHT (lface) = Qnormal;
6617 if (UNSPECIFIEDP (LFACE_SLANT (lface)))
6618 LFACE_SLANT (lface) = Qnormal;
6619 LFACE_AVGWIDTH (lface) = Qunspecified;
6622 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
6623 LFACE_UNDERLINE (lface) = Qnil;
6625 if (UNSPECIFIEDP (LFACE_OVERLINE (lface)))
6626 LFACE_OVERLINE (lface) = Qnil;
6628 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface)))
6629 LFACE_STRIKE_THROUGH (lface) = Qnil;
6631 if (UNSPECIFIEDP (LFACE_BOX (lface)))
6632 LFACE_BOX (lface) = Qnil;
6634 if (UNSPECIFIEDP (LFACE_INVERSE (lface)))
6635 LFACE_INVERSE (lface) = Qnil;
6637 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
6639 /* This function is called so early that colors are not yet
6640 set in the frame parameter list. */
6641 Lisp_Object color = Fassq (Qforeground_color, f->param_alist);
6643 if (CONSP (color) && STRINGP (XCDR (color)))
6644 LFACE_FOREGROUND (lface) = XCDR (color);
6645 else if (FRAME_WINDOW_P (f))
6646 return 0;
6647 else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
6648 LFACE_FOREGROUND (lface) = build_string (unspecified_fg);
6649 else
6650 abort ();
6653 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
6655 /* This function is called so early that colors are not yet
6656 set in the frame parameter list. */
6657 Lisp_Object color = Fassq (Qbackground_color, f->param_alist);
6658 if (CONSP (color) && STRINGP (XCDR (color)))
6659 LFACE_BACKGROUND (lface) = XCDR (color);
6660 else if (FRAME_WINDOW_P (f))
6661 return 0;
6662 else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
6663 LFACE_BACKGROUND (lface) = build_string (unspecified_bg);
6664 else
6665 abort ();
6668 if (UNSPECIFIEDP (LFACE_STIPPLE (lface)))
6669 LFACE_STIPPLE (lface) = Qnil;
6671 /* Realize the face; it must be fully-specified now. */
6672 xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
6673 check_lface (lface);
6674 bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs);
6675 face = realize_face (c, attrs, 0, NULL, DEFAULT_FACE_ID);
6676 return 1;
6680 /* Realize basic faces other than the default face in face cache C.
6681 SYMBOL is the face name, ID is the face id the realized face must
6682 have. The default face must have been realized already. */
6684 static void
6685 realize_named_face (f, symbol, id)
6686 struct frame *f;
6687 Lisp_Object symbol;
6688 int id;
6690 struct face_cache *c = FRAME_FACE_CACHE (f);
6691 Lisp_Object lface = lface_from_face_name (f, symbol, 0);
6692 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6693 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
6694 struct face *new_face;
6696 /* The default face must exist and be fully specified. */
6697 get_lface_attributes (f, Qdefault, attrs, 1);
6698 check_lface_attrs (attrs);
6699 xassert (lface_fully_specified_p (attrs));
6701 /* If SYMBOL isn't know as a face, create it. */
6702 if (NILP (lface))
6704 Lisp_Object frame;
6705 XSETFRAME (frame, f);
6706 lface = Finternal_make_lisp_face (symbol, frame);
6709 /* Merge SYMBOL's face with the default face. */
6710 get_lface_attributes (f, symbol, symbol_attrs, 1);
6711 merge_face_vectors (f, symbol_attrs, attrs, Qnil);
6713 /* Realize the face. */
6714 new_face = realize_face (c, attrs, 0, NULL, id);
6718 /* Realize the fully-specified face with attributes ATTRS in face
6719 cache CACHE for character C. If C is a multibyte character,
6720 BASE_FACE is a face that has the same attributes. Otherwise,
6721 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6722 ID of face to remove before caching the new face. Value is a
6723 pointer to the newly created realized face. */
6725 static struct face *
6726 realize_face (cache, attrs, c, base_face, former_face_id)
6727 struct face_cache *cache;
6728 Lisp_Object *attrs;
6729 int c;
6730 struct face *base_face;
6731 int former_face_id;
6733 struct face *face;
6735 /* LFACE must be fully specified. */
6736 xassert (cache != NULL);
6737 check_lface_attrs (attrs);
6739 if (former_face_id >= 0 && cache->used > former_face_id)
6741 /* Remove the former face. */
6742 struct face *former_face = cache->faces_by_id[former_face_id];
6743 uncache_face (cache, former_face);
6744 free_realized_face (cache->f, former_face);
6747 if (FRAME_WINDOW_P (cache->f))
6748 face = realize_x_face (cache, attrs, c, base_face);
6749 else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
6750 face = realize_tty_face (cache, attrs, c);
6751 else
6752 abort ();
6754 /* Insert the new face. */
6755 cache_face (cache, face, lface_hash (attrs));
6756 #ifdef HAVE_WINDOW_SYSTEM
6757 if (FRAME_WINDOW_P (cache->f) && face->font == NULL)
6758 load_face_font (cache->f, face, c);
6759 #endif /* HAVE_WINDOW_SYSTEM */
6760 return face;
6764 /* Realize the fully-specified face with attributes ATTRS in face
6765 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6766 a multibyte character, BASE_FACE is a face that has the same
6767 attributes. Otherwise, BASE_FACE is ignored. If the new face
6768 doesn't share font with the default face, a fontname is allocated
6769 from the heap and set in `font_name' of the new face, but it is not
6770 yet loaded here. Value is a pointer to the newly created realized
6771 face. */
6773 static struct face *
6774 realize_x_face (cache, attrs, c, base_face)
6775 struct face_cache *cache;
6776 Lisp_Object *attrs;
6777 int c;
6778 struct face *base_face;
6780 #ifdef HAVE_WINDOW_SYSTEM
6781 struct face *face, *default_face;
6782 struct frame *f;
6783 Lisp_Object stipple, overline, strike_through, box;
6785 xassert (FRAME_WINDOW_P (cache->f));
6786 xassert (SINGLE_BYTE_CHAR_P (c)
6787 || base_face);
6789 /* Allocate a new realized face. */
6790 face = make_realized_face (attrs);
6792 f = cache->f;
6794 /* If C is a multibyte character, we share all face attirbutes with
6795 BASE_FACE including the realized fontset. But, we must load a
6796 different font. */
6797 if (!SINGLE_BYTE_CHAR_P (c))
6799 bcopy (base_face, face, sizeof *face);
6800 face->gc = 0;
6802 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6803 face->colors_copied_bitwise_p = 1;
6805 /* to force realize_face to load font */
6806 face->font = NULL;
6807 return face;
6810 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6812 /* Determine the font to use. Most of the time, the font will be
6813 the same as the font of the default face, so try that first. */
6814 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6815 if (default_face
6816 && FACE_SUITABLE_FOR_CHAR_P (default_face, c)
6817 && lface_same_font_attributes_p (default_face->lface, attrs))
6819 face->font = default_face->font;
6820 face->fontset = default_face->fontset;
6821 face->font_info_id = default_face->font_info_id;
6822 face->font_name = default_face->font_name;
6823 face->ascii_face = face;
6825 /* But, as we can't share the fontset, make a new realized
6826 fontset that has the same base fontset as of the default
6827 face. */
6828 face->fontset
6829 = make_fontset_for_ascii_face (f, default_face->fontset);
6831 else
6833 /* If the face attribute ATTRS specifies a fontset, use it as
6834 the base of a new realized fontset. Otherwise, use the same
6835 base fontset as of the default face. The base determines
6836 registry and encoding of a font. It may also determine
6837 foundry and family. The other fields of font name pattern
6838 are constructed from ATTRS. */
6839 int fontset = face_fontset (attrs);
6841 if ((fontset == -1) && default_face)
6842 fontset = default_face->fontset;
6843 face->fontset = make_fontset_for_ascii_face (f, fontset);
6844 face->font = NULL; /* to force realize_face to load font */
6847 /* Load colors, and set remaining attributes. */
6849 load_face_colors (f, face, attrs);
6851 /* Set up box. */
6852 box = attrs[LFACE_BOX_INDEX];
6853 if (STRINGP (box))
6855 /* A simple box of line width 1 drawn in color given by
6856 the string. */
6857 face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX],
6858 LFACE_BOX_INDEX);
6859 face->box = FACE_SIMPLE_BOX;
6860 face->box_line_width = 1;
6862 else if (INTEGERP (box))
6864 /* Simple box of specified line width in foreground color of the
6865 face. */
6866 xassert (XINT (box) != 0);
6867 face->box = FACE_SIMPLE_BOX;
6868 face->box_line_width = XINT (box);
6869 face->box_color = face->foreground;
6870 face->box_color_defaulted_p = 1;
6872 else if (CONSP (box))
6874 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6875 being one of `raised' or `sunken'. */
6876 face->box = FACE_SIMPLE_BOX;
6877 face->box_color = face->foreground;
6878 face->box_color_defaulted_p = 1;
6879 face->box_line_width = 1;
6881 while (CONSP (box))
6883 Lisp_Object keyword, value;
6885 keyword = XCAR (box);
6886 box = XCDR (box);
6888 if (!CONSP (box))
6889 break;
6890 value = XCAR (box);
6891 box = XCDR (box);
6893 if (EQ (keyword, QCline_width))
6895 if (INTEGERP (value) && XINT (value) != 0)
6896 face->box_line_width = XINT (value);
6898 else if (EQ (keyword, QCcolor))
6900 if (STRINGP (value))
6902 face->box_color = load_color (f, face, value,
6903 LFACE_BOX_INDEX);
6904 face->use_box_color_for_shadows_p = 1;
6907 else if (EQ (keyword, QCstyle))
6909 if (EQ (value, Qreleased_button))
6910 face->box = FACE_RAISED_BOX;
6911 else if (EQ (value, Qpressed_button))
6912 face->box = FACE_SUNKEN_BOX;
6917 /* Text underline, overline, strike-through. */
6919 if (EQ (attrs[LFACE_UNDERLINE_INDEX], Qt))
6921 /* Use default color (same as foreground color). */
6922 face->underline_p = 1;
6923 face->underline_defaulted_p = 1;
6924 face->underline_color = 0;
6926 else if (STRINGP (attrs[LFACE_UNDERLINE_INDEX]))
6928 /* Use specified color. */
6929 face->underline_p = 1;
6930 face->underline_defaulted_p = 0;
6931 face->underline_color
6932 = load_color (f, face, attrs[LFACE_UNDERLINE_INDEX],
6933 LFACE_UNDERLINE_INDEX);
6935 else if (NILP (attrs[LFACE_UNDERLINE_INDEX]))
6937 face->underline_p = 0;
6938 face->underline_defaulted_p = 0;
6939 face->underline_color = 0;
6942 overline = attrs[LFACE_OVERLINE_INDEX];
6943 if (STRINGP (overline))
6945 face->overline_color
6946 = load_color (f, face, attrs[LFACE_OVERLINE_INDEX],
6947 LFACE_OVERLINE_INDEX);
6948 face->overline_p = 1;
6950 else if (EQ (overline, Qt))
6952 face->overline_color = face->foreground;
6953 face->overline_color_defaulted_p = 1;
6954 face->overline_p = 1;
6957 strike_through = attrs[LFACE_STRIKE_THROUGH_INDEX];
6958 if (STRINGP (strike_through))
6960 face->strike_through_color
6961 = load_color (f, face, attrs[LFACE_STRIKE_THROUGH_INDEX],
6962 LFACE_STRIKE_THROUGH_INDEX);
6963 face->strike_through_p = 1;
6965 else if (EQ (strike_through, Qt))
6967 face->strike_through_color = face->foreground;
6968 face->strike_through_color_defaulted_p = 1;
6969 face->strike_through_p = 1;
6972 stipple = attrs[LFACE_STIPPLE_INDEX];
6973 if (!NILP (stipple))
6974 face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
6976 xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
6977 return face;
6978 #endif /* HAVE_WINDOW_SYSTEM */
6982 /* Map a specified color of face FACE on frame F to a tty color index.
6983 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6984 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6985 default foreground/background colors. */
6987 static void
6988 map_tty_color (f, face, idx, defaulted)
6989 struct frame *f;
6990 struct face *face;
6991 enum lface_attribute_index idx;
6992 int *defaulted;
6994 Lisp_Object frame, color, def;
6995 int foreground_p = idx == LFACE_FOREGROUND_INDEX;
6996 unsigned long default_pixel, default_other_pixel, pixel;
6998 xassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
7000 if (foreground_p)
7002 pixel = default_pixel = FACE_TTY_DEFAULT_FG_COLOR;
7003 default_other_pixel = FACE_TTY_DEFAULT_BG_COLOR;
7005 else
7007 pixel = default_pixel = FACE_TTY_DEFAULT_BG_COLOR;
7008 default_other_pixel = FACE_TTY_DEFAULT_FG_COLOR;
7011 XSETFRAME (frame, f);
7012 color = face->lface[idx];
7014 if (STRINGP (color)
7015 && SCHARS (color)
7016 && CONSP (Vtty_defined_color_alist)
7017 && (def = assq_no_quit (color, call1 (Qtty_color_alist, frame)),
7018 CONSP (def)))
7020 /* Associations in tty-defined-color-alist are of the form
7021 (NAME INDEX R G B). We need the INDEX part. */
7022 pixel = XINT (XCAR (XCDR (def)));
7025 if (pixel == default_pixel && STRINGP (color))
7027 pixel = load_color (f, face, color, idx);
7029 #if defined (MSDOS) || defined (WINDOWSNT)
7030 /* If the foreground of the default face is the default color,
7031 use the foreground color defined by the frame. */
7032 #ifdef MSDOS
7033 if (FRAME_MSDOS_P (f))
7035 #endif /* MSDOS */
7036 if (pixel == default_pixel
7037 || pixel == FACE_TTY_DEFAULT_COLOR)
7039 if (foreground_p)
7040 pixel = FRAME_FOREGROUND_PIXEL (f);
7041 else
7042 pixel = FRAME_BACKGROUND_PIXEL (f);
7043 face->lface[idx] = tty_color_name (f, pixel);
7044 *defaulted = 1;
7046 else if (pixel == default_other_pixel)
7048 if (foreground_p)
7049 pixel = FRAME_BACKGROUND_PIXEL (f);
7050 else
7051 pixel = FRAME_FOREGROUND_PIXEL (f);
7052 face->lface[idx] = tty_color_name (f, pixel);
7053 *defaulted = 1;
7055 #ifdef MSDOS
7057 #endif
7058 #endif /* MSDOS or WINDOWSNT */
7061 if (foreground_p)
7062 face->foreground = pixel;
7063 else
7064 face->background = pixel;
7068 /* Realize the fully-specified face with attributes ATTRS in face
7069 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
7070 pointer to the newly created realized face. */
7072 static struct face *
7073 realize_tty_face (cache, attrs, c)
7074 struct face_cache *cache;
7075 Lisp_Object *attrs;
7076 int c;
7078 struct face *face;
7079 int weight, slant;
7080 int face_colors_defaulted = 0;
7081 struct frame *f = cache->f;
7083 /* Frame must be a termcap frame. */
7084 xassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
7086 /* Allocate a new realized face. */
7087 face = make_realized_face (attrs);
7088 face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
7090 /* Map face attributes to TTY appearances. We map slant to
7091 dimmed text because we want italic text to appear differently
7092 and because dimmed text is probably used infrequently. */
7093 weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
7094 slant = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
7096 if (weight > XLFD_WEIGHT_MEDIUM)
7097 face->tty_bold_p = 1;
7098 if (weight < XLFD_WEIGHT_MEDIUM || slant != XLFD_SLANT_ROMAN)
7099 face->tty_dim_p = 1;
7100 if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
7101 face->tty_underline_p = 1;
7102 if (!NILP (attrs[LFACE_INVERSE_INDEX]))
7103 face->tty_reverse_p = 1;
7105 /* Map color names to color indices. */
7106 map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
7107 map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
7109 /* Swap colors if face is inverse-video. If the colors are taken
7110 from the frame colors, they are already inverted, since the
7111 frame-creation function calls x-handle-reverse-video. */
7112 if (face->tty_reverse_p && !face_colors_defaulted)
7114 unsigned long tem = face->foreground;
7115 face->foreground = face->background;
7116 face->background = tem;
7119 if (tty_suppress_bold_inverse_default_colors_p
7120 && face->tty_bold_p
7121 && face->background == FACE_TTY_DEFAULT_FG_COLOR
7122 && face->foreground == FACE_TTY_DEFAULT_BG_COLOR)
7123 face->tty_bold_p = 0;
7125 return face;
7129 DEFUN ("tty-suppress-bold-inverse-default-colors",
7130 Ftty_suppress_bold_inverse_default_colors,
7131 Stty_suppress_bold_inverse_default_colors, 1, 1, 0,
7132 doc: /* Suppress/allow boldness of faces with inverse default colors.
7133 SUPPRESS non-nil means suppress it.
7134 This affects bold faces on TTYs whose foreground is the default background
7135 color of the display and whose background is the default foreground color.
7136 For such faces, the bold face attribute is ignored if this variable
7137 is non-nil. */)
7138 (suppress)
7139 Lisp_Object suppress;
7141 tty_suppress_bold_inverse_default_colors_p = !NILP (suppress);
7142 ++face_change_count;
7143 return suppress;
7148 /***********************************************************************
7149 Computing Faces
7150 ***********************************************************************/
7152 /* Return the ID of the face to use to display character CH with face
7153 property PROP on frame F in current_buffer. */
7156 compute_char_face (f, ch, prop)
7157 struct frame *f;
7158 int ch;
7159 Lisp_Object prop;
7161 int face_id;
7163 if (NILP (current_buffer->enable_multibyte_characters))
7164 ch = 0;
7166 if (NILP (prop))
7168 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
7169 face_id = FACE_FOR_CHAR (f, face, ch);
7171 else
7173 Lisp_Object attrs[LFACE_VECTOR_SIZE];
7174 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
7175 bcopy (default_face->lface, attrs, sizeof attrs);
7176 merge_face_vector_with_property (f, attrs, prop);
7177 face_id = lookup_face (f, attrs, ch, NULL);
7180 return face_id;
7183 /* Return the face ID associated with buffer position POS for
7184 displaying ASCII characters. Return in *ENDPTR the position at
7185 which a different face is needed, as far as text properties and
7186 overlays are concerned. W is a window displaying current_buffer.
7188 REGION_BEG, REGION_END delimit the region, so it can be
7189 highlighted.
7191 LIMIT is a position not to scan beyond. That is to limit the time
7192 this function can take.
7194 If MOUSE is non-zero, use the character's mouse-face, not its face.
7196 The face returned is suitable for displaying ASCII characters. */
7199 face_at_buffer_position (w, pos, region_beg, region_end,
7200 endptr, limit, mouse)
7201 struct window *w;
7202 int pos;
7203 int region_beg, region_end;
7204 int *endptr;
7205 int limit;
7206 int mouse;
7208 struct frame *f = XFRAME (w->frame);
7209 Lisp_Object attrs[LFACE_VECTOR_SIZE];
7210 Lisp_Object prop, position;
7211 int i, noverlays;
7212 Lisp_Object *overlay_vec;
7213 Lisp_Object frame;
7214 int endpos;
7215 Lisp_Object propname = mouse ? Qmouse_face : Qface;
7216 Lisp_Object limit1, end;
7217 struct face *default_face;
7219 /* W must display the current buffer. We could write this function
7220 to use the frame and buffer of W, but right now it doesn't. */
7221 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7223 XSETFRAME (frame, f);
7224 XSETFASTINT (position, pos);
7226 endpos = ZV;
7227 if (pos < region_beg && region_beg < endpos)
7228 endpos = region_beg;
7230 /* Get the `face' or `mouse_face' text property at POS, and
7231 determine the next position at which the property changes. */
7232 prop = Fget_text_property (position, propname, w->buffer);
7233 XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
7234 end = Fnext_single_property_change (position, propname, w->buffer, limit1);
7235 if (INTEGERP (end))
7236 endpos = XINT (end);
7238 /* Look at properties from overlays. */
7240 int next_overlay;
7241 int len;
7243 /* First try with room for 40 overlays. */
7244 len = 40;
7245 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
7246 noverlays = overlays_at (pos, 0, &overlay_vec, &len,
7247 &next_overlay, NULL, 0);
7249 /* If there are more than 40, make enough space for all, and try
7250 again. */
7251 if (noverlays > len)
7253 len = noverlays;
7254 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
7255 noverlays = overlays_at (pos, 0, &overlay_vec, &len,
7256 &next_overlay, NULL, 0);
7259 if (next_overlay < endpos)
7260 endpos = next_overlay;
7263 *endptr = endpos;
7265 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
7267 /* Optimize common cases where we can use the default face. */
7268 if (noverlays == 0
7269 && NILP (prop)
7270 && !(pos >= region_beg && pos < region_end))
7271 return DEFAULT_FACE_ID;
7273 /* Begin with attributes from the default face. */
7274 bcopy (default_face->lface, attrs, sizeof attrs);
7276 /* Merge in attributes specified via text properties. */
7277 if (!NILP (prop))
7278 merge_face_vector_with_property (f, attrs, prop);
7280 /* Now merge the overlay data. */
7281 noverlays = sort_overlays (overlay_vec, noverlays, w);
7282 for (i = 0; i < noverlays; i++)
7284 Lisp_Object oend;
7285 int oendpos;
7287 prop = Foverlay_get (overlay_vec[i], propname);
7288 if (!NILP (prop))
7289 merge_face_vector_with_property (f, attrs, prop);
7291 oend = OVERLAY_END (overlay_vec[i]);
7292 oendpos = OVERLAY_POSITION (oend);
7293 if (oendpos < endpos)
7294 endpos = oendpos;
7297 /* If in the region, merge in the region face. */
7298 if (pos >= region_beg && pos < region_end)
7300 Lisp_Object region_face = lface_from_face_name (f, Qregion, 0);
7301 merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil);
7303 if (region_end < endpos)
7304 endpos = region_end;
7307 *endptr = endpos;
7309 /* Look up a realized face with the given face attributes,
7310 or realize a new one for ASCII characters. */
7311 return lookup_face (f, attrs, 0, NULL);
7315 /* Compute the face at character position POS in Lisp string STRING on
7316 window W, for ASCII characters.
7318 If STRING is an overlay string, it comes from position BUFPOS in
7319 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7320 not an overlay string. W must display the current buffer.
7321 REGION_BEG and REGION_END give the start and end positions of the
7322 region; both are -1 if no region is visible.
7324 BASE_FACE_ID is the id of a face to merge with. For strings coming
7325 from overlays or the `display' property it is the face at BUFPOS.
7327 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7329 Set *ENDPTR to the next position where to check for faces in
7330 STRING; -1 if the face is constant from POS to the end of the
7331 string.
7333 Value is the id of the face to use. The face returned is suitable
7334 for displaying ASCII characters. */
7337 face_at_string_position (w, string, pos, bufpos, region_beg,
7338 region_end, endptr, base_face_id, mouse_p)
7339 struct window *w;
7340 Lisp_Object string;
7341 int pos, bufpos;
7342 int region_beg, region_end;
7343 int *endptr;
7344 enum face_id base_face_id;
7345 int mouse_p;
7347 Lisp_Object prop, position, end, limit;
7348 struct frame *f = XFRAME (WINDOW_FRAME (w));
7349 Lisp_Object attrs[LFACE_VECTOR_SIZE];
7350 struct face *base_face;
7351 int multibyte_p = STRING_MULTIBYTE (string);
7352 Lisp_Object prop_name = mouse_p ? Qmouse_face : Qface;
7354 /* Get the value of the face property at the current position within
7355 STRING. Value is nil if there is no face property. */
7356 XSETFASTINT (position, pos);
7357 prop = Fget_text_property (position, prop_name, string);
7359 /* Get the next position at which to check for faces. Value of end
7360 is nil if face is constant all the way to the end of the string.
7361 Otherwise it is a string position where to check faces next.
7362 Limit is the maximum position up to which to check for property
7363 changes in Fnext_single_property_change. Strings are usually
7364 short, so set the limit to the end of the string. */
7365 XSETFASTINT (limit, SCHARS (string));
7366 end = Fnext_single_property_change (position, prop_name, string, limit);
7367 if (INTEGERP (end))
7368 *endptr = XFASTINT (end);
7369 else
7370 *endptr = -1;
7372 base_face = FACE_FROM_ID (f, base_face_id);
7373 xassert (base_face);
7375 /* Optimize the default case that there is no face property and we
7376 are not in the region. */
7377 if (NILP (prop)
7378 && (base_face_id != DEFAULT_FACE_ID
7379 /* BUFPOS <= 0 means STRING is not an overlay string, so
7380 that the region doesn't have to be taken into account. */
7381 || bufpos <= 0
7382 || bufpos < region_beg
7383 || bufpos >= region_end)
7384 && (multibyte_p
7385 /* We can't realize faces for different charsets differently
7386 if we don't have fonts, so we can stop here if not working
7387 on a window-system frame. */
7388 || !FRAME_WINDOW_P (f)
7389 || FACE_SUITABLE_FOR_CHAR_P (base_face, 0)))
7390 return base_face->id;
7392 /* Begin with attributes from the base face. */
7393 bcopy (base_face->lface, attrs, sizeof attrs);
7395 /* Merge in attributes specified via text properties. */
7396 if (!NILP (prop))
7397 merge_face_vector_with_property (f, attrs, prop);
7399 /* If in the region, merge in the region face. */
7400 if (bufpos
7401 && bufpos >= region_beg
7402 && bufpos < region_end)
7404 Lisp_Object region_face = lface_from_face_name (f, Qregion, 0);
7405 merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil);
7408 /* Look up a realized face with the given face attributes,
7409 or realize a new one for ASCII characters. */
7410 return lookup_face (f, attrs, 0, NULL);
7415 /***********************************************************************
7416 Tests
7417 ***********************************************************************/
7419 #if GLYPH_DEBUG
7421 /* Print the contents of the realized face FACE to stderr. */
7423 static void
7424 dump_realized_face (face)
7425 struct face *face;
7427 fprintf (stderr, "ID: %d\n", face->id);
7428 #ifdef HAVE_X_WINDOWS
7429 fprintf (stderr, "gc: %d\n", (int) face->gc);
7430 #endif
7431 fprintf (stderr, "foreground: 0x%lx (%s)\n",
7432 face->foreground,
7433 SDATA (face->lface[LFACE_FOREGROUND_INDEX]));
7434 fprintf (stderr, "background: 0x%lx (%s)\n",
7435 face->background,
7436 SDATA (face->lface[LFACE_BACKGROUND_INDEX]));
7437 fprintf (stderr, "font_name: %s (%s)\n",
7438 face->font_name,
7439 SDATA (face->lface[LFACE_FAMILY_INDEX]));
7440 #ifdef HAVE_X_WINDOWS
7441 fprintf (stderr, "font = %p\n", face->font);
7442 #endif
7443 fprintf (stderr, "font_info_id = %d\n", face->font_info_id);
7444 fprintf (stderr, "fontset: %d\n", face->fontset);
7445 fprintf (stderr, "underline: %d (%s)\n",
7446 face->underline_p,
7447 SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
7448 fprintf (stderr, "hash: %d\n", face->hash);
7449 fprintf (stderr, "charset: %d\n", face->charset);
7453 DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: /* */)
7455 Lisp_Object n;
7457 if (NILP (n))
7459 int i;
7461 fprintf (stderr, "font selection order: ");
7462 for (i = 0; i < DIM (font_sort_order); ++i)
7463 fprintf (stderr, "%d ", font_sort_order[i]);
7464 fprintf (stderr, "\n");
7466 fprintf (stderr, "alternative fonts: ");
7467 debug_print (Vface_alternative_font_family_alist);
7468 fprintf (stderr, "\n");
7470 for (i = 0; i < FRAME_FACE_CACHE (SELECTED_FRAME ())->used; ++i)
7471 Fdump_face (make_number (i));
7473 else
7475 struct face *face;
7476 CHECK_NUMBER (n);
7477 face = FACE_FROM_ID (SELECTED_FRAME (), XINT (n));
7478 if (face == NULL)
7479 error ("Not a valid face");
7480 dump_realized_face (face);
7483 return Qnil;
7487 DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
7488 0, 0, 0, doc: /* */)
7491 fprintf (stderr, "number of colors = %d\n", ncolors_allocated);
7492 fprintf (stderr, "number of pixmaps = %d\n", npixmaps_allocated);
7493 fprintf (stderr, "number of GCs = %d\n", ngcs);
7494 return Qnil;
7497 #endif /* GLYPH_DEBUG != 0 */
7501 /***********************************************************************
7502 Initialization
7503 ***********************************************************************/
7505 void
7506 syms_of_xfaces ()
7508 Qface = intern ("face");
7509 staticpro (&Qface);
7510 Qbitmap_spec_p = intern ("bitmap-spec-p");
7511 staticpro (&Qbitmap_spec_p);
7512 Qframe_update_face_colors = intern ("frame-update-face-colors");
7513 staticpro (&Qframe_update_face_colors);
7515 /* Lisp face attribute keywords. */
7516 QCfamily = intern (":family");
7517 staticpro (&QCfamily);
7518 QCheight = intern (":height");
7519 staticpro (&QCheight);
7520 QCweight = intern (":weight");
7521 staticpro (&QCweight);
7522 QCslant = intern (":slant");
7523 staticpro (&QCslant);
7524 QCunderline = intern (":underline");
7525 staticpro (&QCunderline);
7526 QCinverse_video = intern (":inverse-video");
7527 staticpro (&QCinverse_video);
7528 QCreverse_video = intern (":reverse-video");
7529 staticpro (&QCreverse_video);
7530 QCforeground = intern (":foreground");
7531 staticpro (&QCforeground);
7532 QCbackground = intern (":background");
7533 staticpro (&QCbackground);
7534 QCstipple = intern (":stipple");;
7535 staticpro (&QCstipple);
7536 QCwidth = intern (":width");
7537 staticpro (&QCwidth);
7538 QCfont = intern (":font");
7539 staticpro (&QCfont);
7540 QCbold = intern (":bold");
7541 staticpro (&QCbold);
7542 QCitalic = intern (":italic");
7543 staticpro (&QCitalic);
7544 QCoverline = intern (":overline");
7545 staticpro (&QCoverline);
7546 QCstrike_through = intern (":strike-through");
7547 staticpro (&QCstrike_through);
7548 QCbox = intern (":box");
7549 staticpro (&QCbox);
7550 QCinherit = intern (":inherit");
7551 staticpro (&QCinherit);
7553 /* Symbols used for Lisp face attribute values. */
7554 QCcolor = intern (":color");
7555 staticpro (&QCcolor);
7556 QCline_width = intern (":line-width");
7557 staticpro (&QCline_width);
7558 QCstyle = intern (":style");
7559 staticpro (&QCstyle);
7560 Qreleased_button = intern ("released-button");
7561 staticpro (&Qreleased_button);
7562 Qpressed_button = intern ("pressed-button");
7563 staticpro (&Qpressed_button);
7564 Qnormal = intern ("normal");
7565 staticpro (&Qnormal);
7566 Qultra_light = intern ("ultra-light");
7567 staticpro (&Qultra_light);
7568 Qextra_light = intern ("extra-light");
7569 staticpro (&Qextra_light);
7570 Qlight = intern ("light");
7571 staticpro (&Qlight);
7572 Qsemi_light = intern ("semi-light");
7573 staticpro (&Qsemi_light);
7574 Qsemi_bold = intern ("semi-bold");
7575 staticpro (&Qsemi_bold);
7576 Qbold = intern ("bold");
7577 staticpro (&Qbold);
7578 Qextra_bold = intern ("extra-bold");
7579 staticpro (&Qextra_bold);
7580 Qultra_bold = intern ("ultra-bold");
7581 staticpro (&Qultra_bold);
7582 Qoblique = intern ("oblique");
7583 staticpro (&Qoblique);
7584 Qitalic = intern ("italic");
7585 staticpro (&Qitalic);
7586 Qreverse_oblique = intern ("reverse-oblique");
7587 staticpro (&Qreverse_oblique);
7588 Qreverse_italic = intern ("reverse-italic");
7589 staticpro (&Qreverse_italic);
7590 Qultra_condensed = intern ("ultra-condensed");
7591 staticpro (&Qultra_condensed);
7592 Qextra_condensed = intern ("extra-condensed");
7593 staticpro (&Qextra_condensed);
7594 Qcondensed = intern ("condensed");
7595 staticpro (&Qcondensed);
7596 Qsemi_condensed = intern ("semi-condensed");
7597 staticpro (&Qsemi_condensed);
7598 Qsemi_expanded = intern ("semi-expanded");
7599 staticpro (&Qsemi_expanded);
7600 Qexpanded = intern ("expanded");
7601 staticpro (&Qexpanded);
7602 Qextra_expanded = intern ("extra-expanded");
7603 staticpro (&Qextra_expanded);
7604 Qultra_expanded = intern ("ultra-expanded");
7605 staticpro (&Qultra_expanded);
7606 Qbackground_color = intern ("background-color");
7607 staticpro (&Qbackground_color);
7608 Qforeground_color = intern ("foreground-color");
7609 staticpro (&Qforeground_color);
7610 Qunspecified = intern ("unspecified");
7611 staticpro (&Qunspecified);
7613 Qface_alias = intern ("face-alias");
7614 staticpro (&Qface_alias);
7615 Qdefault = intern ("default");
7616 staticpro (&Qdefault);
7617 Qtool_bar = intern ("tool-bar");
7618 staticpro (&Qtool_bar);
7619 Qregion = intern ("region");
7620 staticpro (&Qregion);
7621 Qfringe = intern ("fringe");
7622 staticpro (&Qfringe);
7623 Qheader_line = intern ("header-line");
7624 staticpro (&Qheader_line);
7625 Qscroll_bar = intern ("scroll-bar");
7626 staticpro (&Qscroll_bar);
7627 Qmenu = intern ("menu");
7628 staticpro (&Qmenu);
7629 Qcursor = intern ("cursor");
7630 staticpro (&Qcursor);
7631 Qborder = intern ("border");
7632 staticpro (&Qborder);
7633 Qmouse = intern ("mouse");
7634 staticpro (&Qmouse);
7635 Qmode_line_inactive = intern ("mode-line-inactive");
7636 staticpro (&Qmode_line_inactive);
7637 Qtty_color_desc = intern ("tty-color-desc");
7638 staticpro (&Qtty_color_desc);
7639 Qtty_color_standard_values = intern ("tty-color-standard-values");
7640 staticpro (&Qtty_color_standard_values);
7641 Qtty_color_by_index = intern ("tty-color-by-index");
7642 staticpro (&Qtty_color_by_index);
7643 Qtty_color_alist = intern ("tty-color-alist");
7644 staticpro (&Qtty_color_alist);
7645 Qscalable_fonts_allowed = intern ("scalable-fonts-allowed");
7646 staticpro (&Qscalable_fonts_allowed);
7648 Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil);
7649 staticpro (&Vparam_value_alist);
7650 Vface_alternative_font_family_alist = Qnil;
7651 staticpro (&Vface_alternative_font_family_alist);
7652 Vface_alternative_font_registry_alist = Qnil;
7653 staticpro (&Vface_alternative_font_registry_alist);
7655 defsubr (&Sinternal_make_lisp_face);
7656 defsubr (&Sinternal_lisp_face_p);
7657 defsubr (&Sinternal_set_lisp_face_attribute);
7658 #ifdef HAVE_WINDOW_SYSTEM
7659 defsubr (&Sinternal_set_lisp_face_attribute_from_resource);
7660 #endif
7661 defsubr (&Scolor_gray_p);
7662 defsubr (&Scolor_supported_p);
7663 defsubr (&Sface_attribute_relative_p);
7664 defsubr (&Smerge_face_attribute);
7665 defsubr (&Sinternal_get_lisp_face_attribute);
7666 defsubr (&Sinternal_lisp_face_attribute_values);
7667 defsubr (&Sinternal_lisp_face_equal_p);
7668 defsubr (&Sinternal_lisp_face_empty_p);
7669 defsubr (&Sinternal_copy_lisp_face);
7670 defsubr (&Sinternal_merge_in_global_face);
7671 defsubr (&Sface_font);
7672 defsubr (&Sframe_face_alist);
7673 defsubr (&Stty_supports_face_attributes_p);
7674 defsubr (&Scolor_distance);
7675 defsubr (&Sinternal_set_font_selection_order);
7676 defsubr (&Sinternal_set_alternative_font_family_alist);
7677 defsubr (&Sinternal_set_alternative_font_registry_alist);
7678 defsubr (&Sface_attributes_as_vector);
7679 #if GLYPH_DEBUG
7680 defsubr (&Sdump_face);
7681 defsubr (&Sshow_face_resources);
7682 #endif /* GLYPH_DEBUG */
7683 defsubr (&Sclear_face_cache);
7684 defsubr (&Stty_suppress_bold_inverse_default_colors);
7686 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7687 defsubr (&Sdump_colors);
7688 #endif
7690 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit,
7691 doc: /* *Limit for font matching.
7692 If an integer > 0, font matching functions won't load more than
7693 that number of fonts when searching for a matching font. */);
7694 Vfont_list_limit = make_number (DEFAULT_FONT_LIST_LIMIT);
7696 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults,
7697 doc: /* List of global face definitions (for internal use only.) */);
7698 Vface_new_frame_defaults = Qnil;
7700 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple,
7701 doc: /* *Default stipple pattern used on monochrome displays.
7702 This stipple pattern is used on monochrome displays
7703 instead of shades of gray for a face background color.
7704 See `set-face-stipple' for possible values for this variable. */);
7705 Vface_default_stipple = build_string ("gray3");
7707 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist,
7708 doc: /* An alist of defined terminal colors and their RGB values. */);
7709 Vtty_defined_color_alist = Qnil;
7711 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed,
7712 doc: /* Allowed scalable fonts.
7713 A value of nil means don't allow any scalable fonts.
7714 A value of t means allow any scalable font.
7715 Otherwise, value must be a list of regular expressions. A font may be
7716 scaled if its name matches a regular expression in the list.
7717 Note that if value is nil, a scalable font might still be used, if no
7718 other font of the appropriate family and registry is available. */);
7719 Vscalable_fonts_allowed = Qnil;
7721 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts,
7722 doc: /* List of ignored fonts.
7723 Each element is a regular expression that matches names of fonts to
7724 ignore. */);
7725 Vface_ignored_fonts = Qnil;
7727 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist,
7728 doc: /* Alist of fonts vs the rescaling factors.
7729 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7730 FONT-NAME-PATTERN is a regular expression matching a font name, and
7731 RESCALE-RATIO is a floating point number to specify how much larger
7732 \(or smaller) font we should use. For instance, if a face requests
7733 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7734 Vface_font_rescale_alist = Qnil;
7736 #ifdef HAVE_WINDOW_SYSTEM
7737 defsubr (&Sbitmap_spec_p);
7738 defsubr (&Sx_list_fonts);
7739 defsubr (&Sinternal_face_x_get_resource);
7740 defsubr (&Sx_family_fonts);
7741 defsubr (&Sx_font_family_list);
7742 #endif /* HAVE_WINDOW_SYSTEM */