(Info-unescape-quotes, Info-split-parameter-string)
[emacs.git] / src / xfaces.c
blob96a1d52b3c2355af0f366162d6500c1a97626bdc
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 #endif /* WINDOWSNT */
233 #ifdef MAC_OS
234 #include "macterm.h"
235 #define x_display_info mac_display_info
236 #define check_x check_mac
237 #endif /* MAC_OS */
239 #include "buffer.h"
240 #include "dispextern.h"
241 #include "blockinput.h"
242 #include "window.h"
243 #include "intervals.h"
245 #ifdef HAVE_X_WINDOWS
247 /* Compensate for a bug in Xos.h on some systems, on which it requires
248 time.h. On some such systems, Xos.h tries to redefine struct
249 timeval and struct timezone if USG is #defined while it is
250 #included. */
252 #ifdef XOS_NEEDS_TIME_H
253 #include <time.h>
254 #undef USG
255 #include <X11/Xos.h>
256 #define USG
257 #define __TIMEVAL__
258 #else /* not XOS_NEEDS_TIME_H */
259 #include <X11/Xos.h>
260 #endif /* not XOS_NEEDS_TIME_H */
262 #endif /* HAVE_X_WINDOWS */
264 #include <stdio.h>
265 #include <ctype.h>
267 #define abs(X) ((X) < 0 ? -(X) : (X))
269 /* Number of pt per inch (from the TeXbook). */
271 #define PT_PER_INCH 72.27
273 /* Non-zero if face attribute ATTR is unspecified. */
275 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
277 /* Value is the number of elements of VECTOR. */
279 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
281 /* Make a copy of string S on the stack using alloca. Value is a pointer
282 to the copy. */
284 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
286 /* Make a copy of the contents of Lisp string S on the stack using
287 alloca. Value is a pointer to the copy. */
289 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
291 /* Size of hash table of realized faces in face caches (should be a
292 prime number). */
294 #define FACE_CACHE_BUCKETS_SIZE 1001
296 /* Keyword symbols used for face attribute names. */
298 Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
299 Lisp_Object QCinverse_video, QCforeground, QCbackground, QCstipple;
300 Lisp_Object QCwidth, QCfont, QCbold, QCitalic;
301 Lisp_Object QCreverse_video;
302 Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
304 /* Symbols used for attribute values. */
306 Lisp_Object Qnormal, Qbold, Qultra_light, Qextra_light, Qlight;
307 Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
308 Lisp_Object Qoblique, Qitalic, Qreverse_oblique, Qreverse_italic;
309 Lisp_Object Qultra_condensed, Qextra_condensed, Qcondensed;
310 Lisp_Object Qsemi_condensed, Qsemi_expanded, Qexpanded, Qextra_expanded;
311 Lisp_Object Qultra_expanded;
312 Lisp_Object Qreleased_button, Qpressed_button;
313 Lisp_Object QCstyle, QCcolor, QCline_width;
314 Lisp_Object Qunspecified;
316 char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
318 /* The name of the function to call when the background of the frame
319 has changed, frame_update_face_colors. */
321 Lisp_Object Qframe_update_face_colors;
323 /* Names of basic faces. */
325 Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
326 Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
327 Lisp_Object Qmode_line_inactive;
328 extern Lisp_Object Qmode_line;
330 /* The symbol `face-alias'. A symbols having that property is an
331 alias for another face. Value of the property is the name of
332 the aliased face. */
334 Lisp_Object Qface_alias;
336 /* Default stipple pattern used on monochrome displays. This stipple
337 pattern is used on monochrome displays instead of shades of gray
338 for a face background color. See `set-face-stipple' for possible
339 values for this variable. */
341 Lisp_Object Vface_default_stipple;
343 /* Alist of alternative font families. Each element is of the form
344 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
345 try FAMILY1, then FAMILY2, ... */
347 Lisp_Object Vface_alternative_font_family_alist;
349 /* Alist of alternative font registries. Each element is of the form
350 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
351 loaded, try REGISTRY1, then REGISTRY2, ... */
353 Lisp_Object Vface_alternative_font_registry_alist;
355 /* Allowed scalable fonts. A value of nil means don't allow any
356 scalable fonts. A value of t means allow the use of any scalable
357 font. Otherwise, value must be a list of regular expressions. A
358 font may be scaled if its name matches a regular expression in the
359 list. */
361 Lisp_Object Vscalable_fonts_allowed, Qscalable_fonts_allowed;
363 /* List of regular expressions that matches names of fonts to ignore. */
365 Lisp_Object Vface_ignored_fonts;
367 /* Alist of font name patterns vs the rescaling factor. */
369 Lisp_Object Vface_font_rescale_alist;
371 /* Maximum number of fonts to consider in font_list. If not an
372 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
374 Lisp_Object Vfont_list_limit;
375 #define DEFAULT_FONT_LIST_LIMIT 100
377 /* The symbols `foreground-color' and `background-color' which can be
378 used as part of a `face' property. This is for compatibility with
379 Emacs 20.2. */
381 Lisp_Object Qforeground_color, Qbackground_color;
383 /* The symbols `face' and `mouse-face' used as text properties. */
385 Lisp_Object Qface;
386 extern Lisp_Object Qmouse_face;
388 /* Error symbol for wrong_type_argument in load_pixmap. */
390 Lisp_Object Qbitmap_spec_p;
392 /* Alist of global face definitions. Each element is of the form
393 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
394 is a Lisp vector of face attributes. These faces are used
395 to initialize faces for new frames. */
397 Lisp_Object Vface_new_frame_defaults;
399 /* The next ID to assign to Lisp faces. */
401 static int next_lface_id;
403 /* A vector mapping Lisp face Id's to face names. */
405 static Lisp_Object *lface_id_to_name;
406 static int lface_id_to_name_size;
408 /* TTY color-related functions (defined in tty-colors.el). */
410 Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
412 /* The name of the function used to compute colors on TTYs. */
414 Lisp_Object Qtty_color_alist;
416 /* An alist of defined terminal colors and their RGB values. */
418 Lisp_Object Vtty_defined_color_alist;
420 /* Counter for calls to clear_face_cache. If this counter reaches
421 CLEAR_FONT_TABLE_COUNT, and a frame has more than
422 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
424 static int clear_font_table_count;
425 #define CLEAR_FONT_TABLE_COUNT 100
426 #define CLEAR_FONT_TABLE_NFONTS 10
428 /* Non-zero means face attributes have been changed since the last
429 redisplay. Used in redisplay_internal. */
431 int face_change_count;
433 /* Non-zero means don't display bold text if a face's foreground
434 and background colors are the inverse of the default colors of the
435 display. This is a kluge to suppress `bold black' foreground text
436 which is hard to read on an LCD monitor. */
438 int tty_suppress_bold_inverse_default_colors_p;
440 /* A list of the form `((x . y))' used to avoid consing in
441 Finternal_set_lisp_face_attribute. */
443 static Lisp_Object Vparam_value_alist;
445 /* The total number of colors currently allocated. */
447 #if GLYPH_DEBUG
448 static int ncolors_allocated;
449 static int npixmaps_allocated;
450 static int ngcs;
451 #endif
453 /* Non-zero means the definition of the `menu' face for new frames has
454 been changed. */
456 int menu_face_changed_default;
459 /* Function prototypes. */
461 struct font_name;
462 struct table_entry;
464 static void map_tty_color P_ ((struct frame *, struct face *,
465 enum lface_attribute_index, int *));
466 static Lisp_Object resolve_face_name P_ ((Lisp_Object));
467 static int may_use_scalable_font_p P_ ((const char *));
468 static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
469 static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
470 int, int));
471 static int x_face_list_fonts P_ ((struct frame *, char *,
472 struct font_name **, int, int));
473 static int font_scalable_p P_ ((struct font_name *));
474 static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
475 static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
476 static unsigned char *xstrlwr P_ ((unsigned char *));
477 static void signal_error P_ ((char *, Lisp_Object));
478 static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
479 static void load_face_font P_ ((struct frame *, struct face *, int));
480 static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
481 static void free_face_colors P_ ((struct frame *, struct face *));
482 static int face_color_gray_p P_ ((struct frame *, char *));
483 static char *build_font_name P_ ((struct font_name *));
484 static void free_font_names P_ ((struct font_name *, int));
485 static int sorted_font_list P_ ((struct frame *, char *,
486 int (*cmpfn) P_ ((const void *, const void *)),
487 struct font_name **));
488 static int font_list_1 P_ ((struct frame *, Lisp_Object, Lisp_Object,
489 Lisp_Object, struct font_name **));
490 static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object,
491 Lisp_Object, struct font_name **));
492 static int try_font_list P_ ((struct frame *, Lisp_Object *,
493 Lisp_Object, Lisp_Object, struct font_name **,
494 int));
495 static int try_alternative_families P_ ((struct frame *f, Lisp_Object,
496 Lisp_Object, struct font_name **));
497 static int cmp_font_names P_ ((const void *, const void *));
498 static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, int,
499 struct face *, int));
500 static struct face *realize_x_face P_ ((struct face_cache *,
501 Lisp_Object *, int, struct face *));
502 static struct face *realize_tty_face P_ ((struct face_cache *,
503 Lisp_Object *, int));
504 static int realize_basic_faces P_ ((struct frame *));
505 static int realize_default_face P_ ((struct frame *));
506 static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
507 static int lface_fully_specified_p P_ ((Lisp_Object *));
508 static int lface_equal_p P_ ((Lisp_Object *, Lisp_Object *));
509 static unsigned hash_string_case_insensitive P_ ((Lisp_Object));
510 static unsigned lface_hash P_ ((Lisp_Object *));
511 static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *));
512 static struct face_cache *make_face_cache P_ ((struct frame *));
513 static void free_realized_face P_ ((struct frame *, struct face *));
514 static void clear_face_gcs P_ ((struct face_cache *));
515 static void free_face_cache P_ ((struct face_cache *));
516 static int face_numeric_weight P_ ((Lisp_Object));
517 static int face_numeric_slant P_ ((Lisp_Object));
518 static int face_numeric_swidth P_ ((Lisp_Object));
519 static int face_fontset P_ ((Lisp_Object *));
520 static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int, int*));
521 static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, Lisp_Object));
522 static void merge_face_inheritance P_ ((struct frame *f, Lisp_Object,
523 Lisp_Object *, Lisp_Object));
524 static void merge_face_vector_with_property P_ ((struct frame *, Lisp_Object *,
525 Lisp_Object));
526 static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object,
527 Lisp_Object, int, int));
528 static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
529 static struct face *make_realized_face P_ ((Lisp_Object *));
530 static void free_realized_faces P_ ((struct face_cache *));
531 static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
532 struct font_name *, int, int, int *));
533 static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
534 static void uncache_face P_ ((struct face_cache *, struct face *));
535 static int xlfd_numeric_slant P_ ((struct font_name *));
536 static int xlfd_numeric_weight P_ ((struct font_name *));
537 static int xlfd_numeric_swidth P_ ((struct font_name *));
538 static Lisp_Object xlfd_symbolic_slant P_ ((struct font_name *));
539 static Lisp_Object xlfd_symbolic_weight P_ ((struct font_name *));
540 static Lisp_Object xlfd_symbolic_swidth P_ ((struct font_name *));
541 static int xlfd_fixed_p P_ ((struct font_name *));
542 static int xlfd_numeric_value P_ ((struct table_entry *, int, struct font_name *,
543 int, int));
544 static Lisp_Object xlfd_symbolic_value P_ ((struct table_entry *, int,
545 struct font_name *, int,
546 Lisp_Object));
547 static struct table_entry *xlfd_lookup_field_contents P_ ((struct table_entry *, int,
548 struct font_name *, int));
550 #ifdef HAVE_WINDOW_SYSTEM
552 static int split_font_name P_ ((struct frame *, struct font_name *, int));
553 static int xlfd_point_size P_ ((struct frame *, struct font_name *));
554 static void sort_fonts P_ ((struct frame *, struct font_name *, int,
555 int (*cmpfn) P_ ((const void *, const void *))));
556 static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
557 static void x_free_gc P_ ((struct frame *, GC));
558 static void clear_font_table P_ ((struct x_display_info *));
560 #ifdef WINDOWSNT
561 extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
562 #endif /* WINDOWSNT */
564 #ifdef USE_X_TOOLKIT
565 static void x_update_menu_appearance P_ ((struct frame *));
567 extern void free_frame_menubar P_ ((struct frame *));
568 #endif /* USE_X_TOOLKIT */
570 #endif /* HAVE_WINDOW_SYSTEM */
573 /***********************************************************************
574 Utilities
575 ***********************************************************************/
577 #ifdef HAVE_X_WINDOWS
579 #ifdef DEBUG_X_COLORS
581 /* The following is a poor mans infrastructure for debugging X color
582 allocation problems on displays with PseudoColor-8. Some X servers
583 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
584 color reference counts completely so that they don't signal an
585 error when a color is freed whose reference count is already 0.
586 Other X servers do. To help me debug this, the following code
587 implements a simple reference counting schema of its own, for a
588 single display/screen. --gerd. */
590 /* Reference counts for pixel colors. */
592 int color_count[256];
594 /* Register color PIXEL as allocated. */
596 void
597 register_color (pixel)
598 unsigned long pixel;
600 xassert (pixel < 256);
601 ++color_count[pixel];
605 /* Register color PIXEL as deallocated. */
607 void
608 unregister_color (pixel)
609 unsigned long pixel;
611 xassert (pixel < 256);
612 if (color_count[pixel] > 0)
613 --color_count[pixel];
614 else
615 abort ();
619 /* Register N colors from PIXELS as deallocated. */
621 void
622 unregister_colors (pixels, n)
623 unsigned long *pixels;
624 int n;
626 int i;
627 for (i = 0; i < n; ++i)
628 unregister_color (pixels[i]);
632 DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
633 doc: /* Dump currently allocated colors to stderr. */)
636 int i, n;
638 fputc ('\n', stderr);
640 for (i = n = 0; i < sizeof color_count / sizeof color_count[0]; ++i)
641 if (color_count[i])
643 fprintf (stderr, "%3d: %5d", i, color_count[i]);
644 ++n;
645 if (n % 5 == 0)
646 fputc ('\n', stderr);
647 else
648 fputc ('\t', stderr);
651 if (n % 5 != 0)
652 fputc ('\n', stderr);
653 return Qnil;
656 #endif /* DEBUG_X_COLORS */
659 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
660 color values. Interrupt input must be blocked when this function
661 is called. */
663 void
664 x_free_colors (f, pixels, npixels)
665 struct frame *f;
666 unsigned long *pixels;
667 int npixels;
669 int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
671 /* If display has an immutable color map, freeing colors is not
672 necessary and some servers don't allow it. So don't do it. */
673 if (class != StaticColor && class != StaticGray && class != TrueColor)
675 #ifdef DEBUG_X_COLORS
676 unregister_colors (pixels, npixels);
677 #endif
678 XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
679 pixels, npixels, 0);
684 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
685 color values. Interrupt input must be blocked when this function
686 is called. */
688 void
689 x_free_dpy_colors (dpy, screen, cmap, pixels, npixels)
690 Display *dpy;
691 Screen *screen;
692 Colormap cmap;
693 unsigned long *pixels;
694 int npixels;
696 struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
697 int class = dpyinfo->visual->class;
699 /* If display has an immutable color map, freeing colors is not
700 necessary and some servers don't allow it. So don't do it. */
701 if (class != StaticColor && class != StaticGray && class != TrueColor)
703 #ifdef DEBUG_X_COLORS
704 unregister_colors (pixels, npixels);
705 #endif
706 XFreeColors (dpy, cmap, pixels, npixels, 0);
711 /* Create and return a GC for use on frame F. GC values and mask
712 are given by XGCV and MASK. */
714 static INLINE GC
715 x_create_gc (f, mask, xgcv)
716 struct frame *f;
717 unsigned long mask;
718 XGCValues *xgcv;
720 GC gc;
721 BLOCK_INPUT;
722 gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
723 UNBLOCK_INPUT;
724 IF_DEBUG (++ngcs);
725 return gc;
729 /* Free GC which was used on frame F. */
731 static INLINE void
732 x_free_gc (f, gc)
733 struct frame *f;
734 GC gc;
736 BLOCK_INPUT;
737 xassert (--ngcs >= 0);
738 XFreeGC (FRAME_X_DISPLAY (f), gc);
739 UNBLOCK_INPUT;
742 #endif /* HAVE_X_WINDOWS */
744 #ifdef WINDOWSNT
745 /* W32 emulation of GCs */
747 static INLINE GC
748 x_create_gc (f, mask, xgcv)
749 struct frame *f;
750 unsigned long mask;
751 XGCValues *xgcv;
753 GC gc;
754 BLOCK_INPUT;
755 gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, xgcv);
756 UNBLOCK_INPUT;
757 IF_DEBUG (++ngcs);
758 return gc;
762 /* Free GC which was used on frame F. */
764 static INLINE void
765 x_free_gc (f, gc)
766 struct frame *f;
767 GC gc;
769 BLOCK_INPUT;
770 xassert (--ngcs >= 0);
771 xfree (gc);
772 UNBLOCK_INPUT;
775 #endif /* WINDOWSNT */
777 #ifdef MAC_OS
778 /* Mac OS emulation of GCs */
780 extern XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
782 static INLINE GC
783 x_create_gc (f, mask, xgcv)
784 struct frame *f;
785 unsigned long mask;
786 XGCValues *xgcv;
788 GC gc;
789 gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
790 return gc;
793 static INLINE void
794 x_free_gc (f, gc)
795 struct frame *f;
796 GC gc;
798 XFreeGC (FRAME_MAC_DISPLAY (f), gc);
801 #endif /* MAC_OS */
803 /* Like stricmp. Used to compare parts of font names which are in
804 ISO8859-1. */
807 xstricmp (s1, s2)
808 const unsigned char *s1, *s2;
810 while (*s1 && *s2)
812 unsigned char c1 = tolower (*s1);
813 unsigned char c2 = tolower (*s2);
814 if (c1 != c2)
815 return c1 < c2 ? -1 : 1;
816 ++s1, ++s2;
819 if (*s1 == 0)
820 return *s2 == 0 ? 0 : -1;
821 return 1;
825 /* Like strlwr, which might not always be available. */
827 static unsigned char *
828 xstrlwr (s)
829 unsigned char *s;
831 unsigned char *p = s;
833 for (p = s; *p; ++p)
834 *p = tolower (*p);
836 return s;
840 /* Signal `error' with message S, and additional argument ARG. */
842 static void
843 signal_error (s, arg)
844 char *s;
845 Lisp_Object arg;
847 Fsignal (Qerror, Fcons (build_string (s), Fcons (arg, Qnil)));
851 /* If FRAME is nil, return a pointer to the selected frame.
852 Otherwise, check that FRAME is a live frame, and return a pointer
853 to it. NPARAM is the parameter number of FRAME, for
854 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
855 Lisp function definitions. */
857 static INLINE struct frame *
858 frame_or_selected_frame (frame, nparam)
859 Lisp_Object frame;
860 int nparam;
862 if (NILP (frame))
863 frame = selected_frame;
865 CHECK_LIVE_FRAME (frame);
866 return XFRAME (frame);
870 /***********************************************************************
871 Frames and faces
872 ***********************************************************************/
874 /* Initialize face cache and basic faces for frame F. */
876 void
877 init_frame_faces (f)
878 struct frame *f;
880 /* Make a face cache, if F doesn't have one. */
881 if (FRAME_FACE_CACHE (f) == NULL)
882 FRAME_FACE_CACHE (f) = make_face_cache (f);
884 #ifdef HAVE_WINDOW_SYSTEM
885 /* Make the image cache. */
886 if (FRAME_WINDOW_P (f))
888 if (FRAME_X_IMAGE_CACHE (f) == NULL)
889 FRAME_X_IMAGE_CACHE (f) = make_image_cache ();
890 ++FRAME_X_IMAGE_CACHE (f)->refcount;
892 #endif /* HAVE_WINDOW_SYSTEM */
894 /* Realize basic faces. Must have enough information in frame
895 parameters to realize basic faces at this point. */
896 #ifdef HAVE_X_WINDOWS
897 if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
898 #endif
899 #ifdef WINDOWSNT
900 if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
901 #endif
902 #ifdef MAC_OS
903 if (!FRAME_MAC_P (f) || FRAME_MAC_WINDOW (f))
904 #endif
905 if (!realize_basic_faces (f))
906 abort ();
910 /* Free face cache of frame F. Called from Fdelete_frame. */
912 void
913 free_frame_faces (f)
914 struct frame *f;
916 struct face_cache *face_cache = FRAME_FACE_CACHE (f);
918 if (face_cache)
920 free_face_cache (face_cache);
921 FRAME_FACE_CACHE (f) = NULL;
924 #ifdef HAVE_WINDOW_SYSTEM
925 if (FRAME_WINDOW_P (f))
927 struct image_cache *image_cache = FRAME_X_IMAGE_CACHE (f);
928 if (image_cache)
930 --image_cache->refcount;
931 if (image_cache->refcount == 0)
932 free_image_cache (f);
935 #endif /* HAVE_WINDOW_SYSTEM */
939 /* Clear face caches, and recompute basic faces for frame F. Call
940 this after changing frame parameters on which those faces depend,
941 or when realized faces have been freed due to changing attributes
942 of named faces. */
944 void
945 recompute_basic_faces (f)
946 struct frame *f;
948 if (FRAME_FACE_CACHE (f))
950 clear_face_cache (0);
951 if (!realize_basic_faces (f))
952 abort ();
957 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
958 try to free unused fonts, too. */
960 void
961 clear_face_cache (clear_fonts_p)
962 int clear_fonts_p;
964 #ifdef HAVE_WINDOW_SYSTEM
965 Lisp_Object tail, frame;
966 struct frame *f;
968 if (clear_fonts_p
969 || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
971 struct x_display_info *dpyinfo;
973 /* Fonts are common for frames on one display, i.e. on
974 one X screen. */
975 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
976 if (dpyinfo->n_fonts > CLEAR_FONT_TABLE_NFONTS)
977 clear_font_table (dpyinfo);
979 /* From time to time see if we can unload some fonts. This also
980 frees all realized faces on all frames. Fonts needed by
981 faces will be loaded again when faces are realized again. */
982 clear_font_table_count = 0;
984 FOR_EACH_FRAME (tail, frame)
986 struct frame *f = XFRAME (frame);
987 if (FRAME_WINDOW_P (f)
988 && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
989 free_all_realized_faces (frame);
992 else
994 /* Clear GCs of realized faces. */
995 FOR_EACH_FRAME (tail, frame)
997 f = XFRAME (frame);
998 if (FRAME_WINDOW_P (f))
1000 clear_face_gcs (FRAME_FACE_CACHE (f));
1001 clear_image_cache (f, 0);
1005 #endif /* HAVE_WINDOW_SYSTEM */
1009 DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
1010 doc: /* Clear face caches on all frames.
1011 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1012 (thoroughly)
1013 Lisp_Object thoroughly;
1015 clear_face_cache (!NILP (thoroughly));
1016 ++face_change_count;
1017 ++windows_or_buffers_changed;
1018 return Qnil;
1023 #ifdef HAVE_WINDOW_SYSTEM
1026 /* Remove fonts from the font table of DPYINFO except for the default
1027 ASCII fonts of frames on that display. Called from clear_face_cache
1028 from time to time. */
1030 static void
1031 clear_font_table (dpyinfo)
1032 struct x_display_info *dpyinfo;
1034 int i;
1036 /* Free those fonts that are not used by frames on DPYINFO. */
1037 for (i = 0; i < dpyinfo->n_fonts; ++i)
1039 struct font_info *font_info = dpyinfo->font_table + i;
1040 Lisp_Object tail, frame;
1042 /* Check if slot is already free. */
1043 if (font_info->name == NULL)
1044 continue;
1046 /* Don't free a default font of some frame. */
1047 FOR_EACH_FRAME (tail, frame)
1049 struct frame *f = XFRAME (frame);
1050 if (FRAME_WINDOW_P (f)
1051 && font_info->font == FRAME_FONT (f))
1052 break;
1055 if (!NILP (tail))
1056 continue;
1058 /* Free names. */
1059 if (font_info->full_name != font_info->name)
1060 xfree (font_info->full_name);
1061 xfree (font_info->name);
1063 /* Free the font. */
1064 BLOCK_INPUT;
1065 #ifdef HAVE_X_WINDOWS
1066 XFreeFont (dpyinfo->display, font_info->font);
1067 #endif
1068 #ifdef WINDOWSNT
1069 w32_unload_font (dpyinfo, font_info->font);
1070 #endif
1071 UNBLOCK_INPUT;
1073 /* Mark font table slot free. */
1074 font_info->font = NULL;
1075 font_info->name = font_info->full_name = NULL;
1079 #endif /* HAVE_WINDOW_SYSTEM */
1083 /***********************************************************************
1084 X Pixmaps
1085 ***********************************************************************/
1087 #ifdef HAVE_WINDOW_SYSTEM
1089 DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
1090 doc: /* Value is non-nil if OBJECT is a valid bitmap specification.
1091 A bitmap specification is either a string, a file name, or a list
1092 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1093 HEIGHT is its height, and DATA is a string containing the bits of
1094 the pixmap. Bits are stored row by row, each row occupies
1095 \(WIDTH + 7)/8 bytes. */)
1096 (object)
1097 Lisp_Object object;
1099 int pixmap_p = 0;
1101 if (STRINGP (object))
1102 /* If OBJECT is a string, it's a file name. */
1103 pixmap_p = 1;
1104 else if (CONSP (object))
1106 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1107 HEIGHT must be integers > 0, and DATA must be string large
1108 enough to hold a bitmap of the specified size. */
1109 Lisp_Object width, height, data;
1111 height = width = data = Qnil;
1113 if (CONSP (object))
1115 width = XCAR (object);
1116 object = XCDR (object);
1117 if (CONSP (object))
1119 height = XCAR (object);
1120 object = XCDR (object);
1121 if (CONSP (object))
1122 data = XCAR (object);
1126 if (NATNUMP (width) && NATNUMP (height) && STRINGP (data))
1128 int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
1129 / BITS_PER_CHAR);
1130 if (SBYTES (data) >= bytes_per_row * XINT (height))
1131 pixmap_p = 1;
1135 return pixmap_p ? Qt : Qnil;
1139 /* Load a bitmap according to NAME (which is either a file name or a
1140 pixmap spec) for use on frame F. Value is the bitmap_id (see
1141 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1142 bitmap cannot be loaded, display a message saying so, and return
1143 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1144 if these pointers are not null. */
1146 static int
1147 load_pixmap (f, name, w_ptr, h_ptr)
1148 FRAME_PTR f;
1149 Lisp_Object name;
1150 unsigned int *w_ptr, *h_ptr;
1152 int bitmap_id;
1153 Lisp_Object tem;
1155 if (NILP (name))
1156 return 0;
1158 tem = Fbitmap_spec_p (name);
1159 if (NILP (tem))
1160 wrong_type_argument (Qbitmap_spec_p, name);
1162 BLOCK_INPUT;
1163 if (CONSP (name))
1165 /* Decode a bitmap spec into a bitmap. */
1167 int h, w;
1168 Lisp_Object bits;
1170 w = XINT (Fcar (name));
1171 h = XINT (Fcar (Fcdr (name)));
1172 bits = Fcar (Fcdr (Fcdr (name)));
1174 bitmap_id = x_create_bitmap_from_data (f, SDATA (bits),
1175 w, h);
1177 else
1179 /* It must be a string -- a file name. */
1180 bitmap_id = x_create_bitmap_from_file (f, name);
1182 UNBLOCK_INPUT;
1184 if (bitmap_id < 0)
1186 add_to_log ("Invalid or undefined bitmap %s", name, Qnil);
1187 bitmap_id = 0;
1189 if (w_ptr)
1190 *w_ptr = 0;
1191 if (h_ptr)
1192 *h_ptr = 0;
1194 else
1196 #if GLYPH_DEBUG
1197 ++npixmaps_allocated;
1198 #endif
1199 if (w_ptr)
1200 *w_ptr = x_bitmap_width (f, bitmap_id);
1202 if (h_ptr)
1203 *h_ptr = x_bitmap_height (f, bitmap_id);
1206 return bitmap_id;
1209 #endif /* HAVE_WINDOW_SYSTEM */
1213 /***********************************************************************
1214 Fonts
1215 ***********************************************************************/
1217 #ifdef HAVE_WINDOW_SYSTEM
1219 /* Load font of face FACE which is used on frame F to display
1220 character C. The name of the font to load is determined by lface
1221 and fontset of FACE. */
1223 static void
1224 load_face_font (f, face, c)
1225 struct frame *f;
1226 struct face *face;
1227 int c;
1229 struct font_info *font_info = NULL;
1230 char *font_name;
1231 int needs_overstrike;
1233 face->font_info_id = -1;
1234 face->font = NULL;
1236 font_name = choose_face_font (f, face->lface, face->fontset, c,
1237 &needs_overstrike);
1238 if (!font_name)
1239 return;
1241 BLOCK_INPUT;
1242 font_info = FS_LOAD_FACE_FONT (f, c, font_name, face);
1243 UNBLOCK_INPUT;
1245 if (font_info)
1247 face->font_info_id = font_info->font_idx;
1248 face->font = font_info->font;
1249 face->font_name = font_info->full_name;
1250 face->overstrike = needs_overstrike;
1251 if (face->gc)
1253 x_free_gc (f, face->gc);
1254 face->gc = 0;
1257 else
1258 add_to_log ("Unable to load font %s",
1259 build_string (font_name), Qnil);
1260 xfree (font_name);
1263 #endif /* HAVE_WINDOW_SYSTEM */
1267 /***********************************************************************
1268 X Colors
1269 ***********************************************************************/
1271 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1272 RGB_LIST should contain (at least) 3 lisp integers.
1273 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1275 static int
1276 parse_rgb_list (rgb_list, color)
1277 Lisp_Object rgb_list;
1278 XColor *color;
1280 #define PARSE_RGB_LIST_FIELD(field) \
1281 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1283 color->field = XINT (XCAR (rgb_list)); \
1284 rgb_list = XCDR (rgb_list); \
1286 else \
1287 return 0;
1289 PARSE_RGB_LIST_FIELD (red);
1290 PARSE_RGB_LIST_FIELD (green);
1291 PARSE_RGB_LIST_FIELD (blue);
1293 return 1;
1297 /* Lookup on frame F the color described by the lisp string COLOR.
1298 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1299 non-zero, then the `standard' definition of the same color is
1300 returned in it. */
1302 static int
1303 tty_lookup_color (f, color, tty_color, std_color)
1304 struct frame *f;
1305 Lisp_Object color;
1306 XColor *tty_color, *std_color;
1308 Lisp_Object frame, color_desc;
1310 if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc)))
1311 return 0;
1313 XSETFRAME (frame, f);
1315 color_desc = call2 (Qtty_color_desc, color, frame);
1316 if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
1318 Lisp_Object rgb;
1320 if (! INTEGERP (XCAR (XCDR (color_desc))))
1321 return 0;
1323 tty_color->pixel = XINT (XCAR (XCDR (color_desc)));
1325 rgb = XCDR (XCDR (color_desc));
1326 if (! parse_rgb_list (rgb, tty_color))
1327 return 0;
1329 /* Should we fill in STD_COLOR too? */
1330 if (std_color)
1332 /* Default STD_COLOR to the same as TTY_COLOR. */
1333 *std_color = *tty_color;
1335 /* Do a quick check to see if the returned descriptor is
1336 actually _exactly_ equal to COLOR, otherwise we have to
1337 lookup STD_COLOR separately. If it's impossible to lookup
1338 a standard color, we just give up and use TTY_COLOR. */
1339 if ((!STRINGP (XCAR (color_desc))
1340 || NILP (Fstring_equal (color, XCAR (color_desc))))
1341 && !NILP (Ffboundp (Qtty_color_standard_values)))
1343 /* Look up STD_COLOR separately. */
1344 rgb = call1 (Qtty_color_standard_values, color);
1345 if (! parse_rgb_list (rgb, std_color))
1346 return 0;
1350 return 1;
1352 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1353 /* We were called early during startup, and the colors are not
1354 yet set up in tty-defined-color-alist. Don't return a failure
1355 indication, since this produces the annoying "Unable to
1356 load color" messages in the *Messages* buffer. */
1357 return 1;
1358 else
1359 /* tty-color-desc seems to have returned a bad value. */
1360 return 0;
1363 /* A version of defined_color for non-X frames. */
1366 tty_defined_color (f, color_name, color_def, alloc)
1367 struct frame *f;
1368 char *color_name;
1369 XColor *color_def;
1370 int alloc;
1372 int status = 1;
1374 /* Defaults. */
1375 color_def->pixel = FACE_TTY_DEFAULT_COLOR;
1376 color_def->red = 0;
1377 color_def->blue = 0;
1378 color_def->green = 0;
1380 if (*color_name)
1381 status = tty_lookup_color (f, build_string (color_name), color_def, 0);
1383 if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
1385 if (strcmp (color_name, "unspecified-fg") == 0)
1386 color_def->pixel = FACE_TTY_DEFAULT_FG_COLOR;
1387 else if (strcmp (color_name, "unspecified-bg") == 0)
1388 color_def->pixel = FACE_TTY_DEFAULT_BG_COLOR;
1391 if (color_def->pixel != FACE_TTY_DEFAULT_COLOR)
1392 status = 1;
1394 return status;
1398 /* Decide if color named COLOR_NAME is valid for the display
1399 associated with the frame F; if so, return the rgb values in
1400 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1402 This does the right thing for any type of frame. */
1405 defined_color (f, color_name, color_def, alloc)
1406 struct frame *f;
1407 char *color_name;
1408 XColor *color_def;
1409 int alloc;
1411 if (!FRAME_WINDOW_P (f))
1412 return tty_defined_color (f, color_name, color_def, alloc);
1413 #ifdef HAVE_X_WINDOWS
1414 else if (FRAME_X_P (f))
1415 return x_defined_color (f, color_name, color_def, alloc);
1416 #endif
1417 #ifdef WINDOWSNT
1418 else if (FRAME_W32_P (f))
1419 return w32_defined_color (f, color_name, color_def, alloc);
1420 #endif
1421 #ifdef MAC_OS
1422 else if (FRAME_MAC_P (f))
1423 return mac_defined_color (f, color_name, color_def, alloc);
1424 #endif
1425 else
1426 abort ();
1430 /* Given the index IDX of a tty color on frame F, return its name, a
1431 Lisp string. */
1433 Lisp_Object
1434 tty_color_name (f, idx)
1435 struct frame *f;
1436 int idx;
1438 if (idx >= 0 && !NILP (Ffboundp (Qtty_color_by_index)))
1440 Lisp_Object frame;
1441 Lisp_Object coldesc;
1443 XSETFRAME (frame, f);
1444 coldesc = call2 (Qtty_color_by_index, make_number (idx), frame);
1446 if (!NILP (coldesc))
1447 return XCAR (coldesc);
1449 #ifdef MSDOS
1450 /* We can have an MSDOG frame under -nw for a short window of
1451 opportunity before internal_terminal_init is called. DTRT. */
1452 if (FRAME_MSDOS_P (f) && !inhibit_window_system)
1453 return msdos_stdcolor_name (idx);
1454 #endif
1456 if (idx == FACE_TTY_DEFAULT_FG_COLOR)
1457 return build_string (unspecified_fg);
1458 if (idx == FACE_TTY_DEFAULT_BG_COLOR)
1459 return build_string (unspecified_bg);
1461 #ifdef WINDOWSNT
1462 return vga_stdcolor_name (idx);
1463 #endif
1465 return Qunspecified;
1469 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1470 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1472 static int
1473 face_color_gray_p (f, color_name)
1474 struct frame *f;
1475 char *color_name;
1477 XColor color;
1478 int gray_p;
1480 if (defined_color (f, color_name, &color, 0))
1481 gray_p = ((abs (color.red - color.green)
1482 < max (color.red, color.green) / 20)
1483 && (abs (color.green - color.blue)
1484 < max (color.green, color.blue) / 20)
1485 && (abs (color.blue - color.red)
1486 < max (color.blue, color.red) / 20));
1487 else
1488 gray_p = 0;
1490 return gray_p;
1494 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1495 BACKGROUND_P non-zero means the color will be used as background
1496 color. */
1498 static int
1499 face_color_supported_p (f, color_name, background_p)
1500 struct frame *f;
1501 char *color_name;
1502 int background_p;
1504 Lisp_Object frame;
1505 XColor not_used;
1507 XSETFRAME (frame, f);
1508 return (FRAME_WINDOW_P (f)
1509 ? (!NILP (Fxw_display_color_p (frame))
1510 || xstricmp (color_name, "black") == 0
1511 || xstricmp (color_name, "white") == 0
1512 || (background_p
1513 && face_color_gray_p (f, color_name))
1514 || (!NILP (Fx_display_grayscale_p (frame))
1515 && face_color_gray_p (f, color_name)))
1516 : tty_defined_color (f, color_name, &not_used, 0));
1520 DEFUN ("color-gray-p", Fcolor_gray_p, Scolor_gray_p, 1, 2, 0,
1521 doc: /* Return non-nil if COLOR is a shade of gray (or white or black).
1522 FRAME specifies the frame and thus the display for interpreting COLOR.
1523 If FRAME is nil or omitted, use the selected frame. */)
1524 (color, frame)
1525 Lisp_Object color, frame;
1527 struct frame *f;
1529 CHECK_FRAME (frame);
1530 CHECK_STRING (color);
1531 f = XFRAME (frame);
1532 return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil;
1536 DEFUN ("color-supported-p", Fcolor_supported_p,
1537 Scolor_supported_p, 1, 3, 0,
1538 doc: /* Return non-nil if COLOR can be displayed on FRAME.
1539 BACKGROUND-P non-nil means COLOR is used as a background.
1540 If FRAME is nil or omitted, use the selected frame.
1541 COLOR must be a valid color name. */)
1542 (color, frame, background_p)
1543 Lisp_Object frame, color, background_p;
1545 struct frame *f;
1547 CHECK_FRAME (frame);
1548 CHECK_STRING (color);
1549 f = XFRAME (frame);
1550 if (face_color_supported_p (f, SDATA (color), !NILP (background_p)))
1551 return Qt;
1552 return Qnil;
1556 /* Load color with name NAME for use by face FACE on frame F.
1557 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1558 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1559 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1560 pixel color. If color cannot be loaded, display a message, and
1561 return the foreground, background or underline color of F, but
1562 record that fact in flags of the face so that we don't try to free
1563 these colors. */
1565 unsigned long
1566 load_color (f, face, name, target_index)
1567 struct frame *f;
1568 struct face *face;
1569 Lisp_Object name;
1570 enum lface_attribute_index target_index;
1572 XColor color;
1574 xassert (STRINGP (name));
1575 xassert (target_index == LFACE_FOREGROUND_INDEX
1576 || target_index == LFACE_BACKGROUND_INDEX
1577 || target_index == LFACE_UNDERLINE_INDEX
1578 || target_index == LFACE_OVERLINE_INDEX
1579 || target_index == LFACE_STRIKE_THROUGH_INDEX
1580 || target_index == LFACE_BOX_INDEX);
1582 /* if the color map is full, defined_color will return a best match
1583 to the values in an existing cell. */
1584 if (!defined_color (f, SDATA (name), &color, 1))
1586 add_to_log ("Unable to load color \"%s\"", name, Qnil);
1588 switch (target_index)
1590 case LFACE_FOREGROUND_INDEX:
1591 face->foreground_defaulted_p = 1;
1592 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1593 break;
1595 case LFACE_BACKGROUND_INDEX:
1596 face->background_defaulted_p = 1;
1597 color.pixel = FRAME_BACKGROUND_PIXEL (f);
1598 break;
1600 case LFACE_UNDERLINE_INDEX:
1601 face->underline_defaulted_p = 1;
1602 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1603 break;
1605 case LFACE_OVERLINE_INDEX:
1606 face->overline_color_defaulted_p = 1;
1607 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1608 break;
1610 case LFACE_STRIKE_THROUGH_INDEX:
1611 face->strike_through_color_defaulted_p = 1;
1612 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1613 break;
1615 case LFACE_BOX_INDEX:
1616 face->box_color_defaulted_p = 1;
1617 color.pixel = FRAME_FOREGROUND_PIXEL (f);
1618 break;
1620 default:
1621 abort ();
1624 #if GLYPH_DEBUG
1625 else
1626 ++ncolors_allocated;
1627 #endif
1629 return color.pixel;
1633 #ifdef HAVE_WINDOW_SYSTEM
1635 /* Load colors for face FACE which is used on frame F. Colors are
1636 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1637 of ATTRS. If the background color specified is not supported on F,
1638 try to emulate gray colors with a stipple from Vface_default_stipple. */
1640 static void
1641 load_face_colors (f, face, attrs)
1642 struct frame *f;
1643 struct face *face;
1644 Lisp_Object *attrs;
1646 Lisp_Object fg, bg;
1648 bg = attrs[LFACE_BACKGROUND_INDEX];
1649 fg = attrs[LFACE_FOREGROUND_INDEX];
1651 /* Swap colors if face is inverse-video. */
1652 if (EQ (attrs[LFACE_INVERSE_INDEX], Qt))
1654 Lisp_Object tmp;
1655 tmp = fg;
1656 fg = bg;
1657 bg = tmp;
1660 /* Check for support for foreground, not for background because
1661 face_color_supported_p is smart enough to know that grays are
1662 "supported" as background because we are supposed to use stipple
1663 for them. */
1664 if (!face_color_supported_p (f, SDATA (bg), 0)
1665 && !NILP (Fbitmap_spec_p (Vface_default_stipple)))
1667 x_destroy_bitmap (f, face->stipple);
1668 face->stipple = load_pixmap (f, Vface_default_stipple,
1669 &face->pixmap_w, &face->pixmap_h);
1672 face->background = load_color (f, face, bg, LFACE_BACKGROUND_INDEX);
1673 face->foreground = load_color (f, face, fg, LFACE_FOREGROUND_INDEX);
1677 /* Free color PIXEL on frame F. */
1679 void
1680 unload_color (f, pixel)
1681 struct frame *f;
1682 unsigned long pixel;
1684 #ifdef HAVE_X_WINDOWS
1685 if (pixel != -1)
1687 BLOCK_INPUT;
1688 x_free_colors (f, &pixel, 1);
1689 UNBLOCK_INPUT;
1691 #endif
1695 /* Free colors allocated for FACE. */
1697 static void
1698 free_face_colors (f, face)
1699 struct frame *f;
1700 struct face *face;
1702 #ifdef HAVE_X_WINDOWS
1703 if (face->colors_copied_bitwise_p)
1704 return;
1706 BLOCK_INPUT;
1708 if (!face->foreground_defaulted_p)
1710 x_free_colors (f, &face->foreground, 1);
1711 IF_DEBUG (--ncolors_allocated);
1714 if (!face->background_defaulted_p)
1716 x_free_colors (f, &face->background, 1);
1717 IF_DEBUG (--ncolors_allocated);
1720 if (face->underline_p
1721 && !face->underline_defaulted_p)
1723 x_free_colors (f, &face->underline_color, 1);
1724 IF_DEBUG (--ncolors_allocated);
1727 if (face->overline_p
1728 && !face->overline_color_defaulted_p)
1730 x_free_colors (f, &face->overline_color, 1);
1731 IF_DEBUG (--ncolors_allocated);
1734 if (face->strike_through_p
1735 && !face->strike_through_color_defaulted_p)
1737 x_free_colors (f, &face->strike_through_color, 1);
1738 IF_DEBUG (--ncolors_allocated);
1741 if (face->box != FACE_NO_BOX
1742 && !face->box_color_defaulted_p)
1744 x_free_colors (f, &face->box_color, 1);
1745 IF_DEBUG (--ncolors_allocated);
1748 UNBLOCK_INPUT;
1749 #endif /* HAVE_X_WINDOWS */
1752 #endif /* HAVE_WINDOW_SYSTEM */
1756 /***********************************************************************
1757 XLFD Font Names
1758 ***********************************************************************/
1760 /* An enumerator for each field of an XLFD font name. */
1762 enum xlfd_field
1764 XLFD_FOUNDRY,
1765 XLFD_FAMILY,
1766 XLFD_WEIGHT,
1767 XLFD_SLANT,
1768 XLFD_SWIDTH,
1769 XLFD_ADSTYLE,
1770 XLFD_PIXEL_SIZE,
1771 XLFD_POINT_SIZE,
1772 XLFD_RESX,
1773 XLFD_RESY,
1774 XLFD_SPACING,
1775 XLFD_AVGWIDTH,
1776 XLFD_REGISTRY,
1777 XLFD_ENCODING,
1778 XLFD_LAST
1781 /* An enumerator for each possible slant value of a font. Taken from
1782 the XLFD specification. */
1784 enum xlfd_slant
1786 XLFD_SLANT_UNKNOWN,
1787 XLFD_SLANT_ROMAN,
1788 XLFD_SLANT_ITALIC,
1789 XLFD_SLANT_OBLIQUE,
1790 XLFD_SLANT_REVERSE_ITALIC,
1791 XLFD_SLANT_REVERSE_OBLIQUE,
1792 XLFD_SLANT_OTHER
1795 /* Relative font weight according to XLFD documentation. */
1797 enum xlfd_weight
1799 XLFD_WEIGHT_UNKNOWN,
1800 XLFD_WEIGHT_ULTRA_LIGHT, /* 10 */
1801 XLFD_WEIGHT_EXTRA_LIGHT, /* 20 */
1802 XLFD_WEIGHT_LIGHT, /* 30 */
1803 XLFD_WEIGHT_SEMI_LIGHT, /* 40: SemiLight, Book, ... */
1804 XLFD_WEIGHT_MEDIUM, /* 50: Medium, Normal, Regular, ... */
1805 XLFD_WEIGHT_SEMI_BOLD, /* 60: SemiBold, DemiBold, ... */
1806 XLFD_WEIGHT_BOLD, /* 70: Bold, ... */
1807 XLFD_WEIGHT_EXTRA_BOLD, /* 80: ExtraBold, Heavy, ... */
1808 XLFD_WEIGHT_ULTRA_BOLD /* 90: UltraBold, Black, ... */
1811 /* Relative proportionate width. */
1813 enum xlfd_swidth
1815 XLFD_SWIDTH_UNKNOWN,
1816 XLFD_SWIDTH_ULTRA_CONDENSED, /* 10 */
1817 XLFD_SWIDTH_EXTRA_CONDENSED, /* 20 */
1818 XLFD_SWIDTH_CONDENSED, /* 30: Condensed, Narrow, Compressed, ... */
1819 XLFD_SWIDTH_SEMI_CONDENSED, /* 40: semicondensed */
1820 XLFD_SWIDTH_MEDIUM, /* 50: Medium, Normal, Regular, ... */
1821 XLFD_SWIDTH_SEMI_EXPANDED, /* 60: SemiExpanded, DemiExpanded, ... */
1822 XLFD_SWIDTH_EXPANDED, /* 70: Expanded... */
1823 XLFD_SWIDTH_EXTRA_EXPANDED, /* 80: ExtraExpanded, Wide... */
1824 XLFD_SWIDTH_ULTRA_EXPANDED /* 90: UltraExpanded... */
1827 /* Structure used for tables mapping XLFD weight, slant, and width
1828 names to numeric and symbolic values. */
1830 struct table_entry
1832 char *name;
1833 int numeric;
1834 Lisp_Object *symbol;
1837 /* Table of XLFD slant names and their numeric and symbolic
1838 representations. This table must be sorted by slant names in
1839 ascending order. */
1841 static struct table_entry slant_table[] =
1843 {"i", XLFD_SLANT_ITALIC, &Qitalic},
1844 {"o", XLFD_SLANT_OBLIQUE, &Qoblique},
1845 {"ot", XLFD_SLANT_OTHER, &Qitalic},
1846 {"r", XLFD_SLANT_ROMAN, &Qnormal},
1847 {"ri", XLFD_SLANT_REVERSE_ITALIC, &Qreverse_italic},
1848 {"ro", XLFD_SLANT_REVERSE_OBLIQUE, &Qreverse_oblique}
1851 /* Table of XLFD weight names. This table must be sorted by weight
1852 names in ascending order. */
1854 static struct table_entry weight_table[] =
1856 {"black", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold},
1857 {"bold", XLFD_WEIGHT_BOLD, &Qbold},
1858 {"book", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
1859 {"demi", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1860 {"demibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1861 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT, &Qextra_light},
1862 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
1863 {"heavy", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
1864 {"light", XLFD_WEIGHT_LIGHT, &Qlight},
1865 {"medium", XLFD_WEIGHT_MEDIUM, &Qnormal},
1866 {"normal", XLFD_WEIGHT_MEDIUM, &Qnormal},
1867 {"regular", XLFD_WEIGHT_MEDIUM, &Qnormal},
1868 {"semibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
1869 {"semilight", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
1870 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT, &Qultra_light},
1871 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold}
1874 /* Table of XLFD width names. This table must be sorted by width
1875 names in ascending order. */
1877 static struct table_entry swidth_table[] =
1879 {"compressed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1880 {"condensed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1881 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
1882 {"expanded", XLFD_SWIDTH_EXPANDED, &Qexpanded},
1883 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED, &Qextra_condensed},
1884 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded},
1885 {"medium", XLFD_SWIDTH_MEDIUM, &Qnormal},
1886 {"narrow", XLFD_SWIDTH_CONDENSED, &Qcondensed},
1887 {"normal", XLFD_SWIDTH_MEDIUM, &Qnormal},
1888 {"regular", XLFD_SWIDTH_MEDIUM, &Qnormal},
1889 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED, &Qsemi_condensed},
1890 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
1891 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED, &Qultra_condensed},
1892 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED, &Qultra_expanded},
1893 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded}
1896 /* Structure used to hold the result of splitting font names in XLFD
1897 format into their fields. */
1899 struct font_name
1901 /* The original name which is modified destructively by
1902 split_font_name. The pointer is kept here to be able to free it
1903 if it was allocated from the heap. */
1904 char *name;
1906 /* Font name fields. Each vector element points into `name' above.
1907 Fields are NUL-terminated. */
1908 char *fields[XLFD_LAST];
1910 /* Numeric values for those fields that interest us. See
1911 split_font_name for which these are. */
1912 int numeric[XLFD_LAST];
1914 /* If the original name matches one of Vface_font_rescale_alist,
1915 the value is the corresponding rescale ratio. Otherwise, the
1916 value is 1.0. */
1917 double rescale_ratio;
1919 /* Lower value mean higher priority. */
1920 int registry_priority;
1923 /* The frame in effect when sorting font names. Set temporarily in
1924 sort_fonts so that it is available in font comparison functions. */
1926 static struct frame *font_frame;
1928 /* Order by which font selection chooses fonts. The default values
1929 mean `first, find a best match for the font width, then for the
1930 font height, then for weight, then for slant.' This variable can be
1931 set via set-face-font-sort-order. */
1933 #ifdef MAC_OS
1934 static int font_sort_order[4] = {
1935 XLFD_SWIDTH, XLFD_POINT_SIZE, XLFD_WEIGHT, XLFD_SLANT
1937 #else
1938 static int font_sort_order[4];
1939 #endif
1941 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1942 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1943 is a pointer to the matching table entry or null if no table entry
1944 matches. */
1946 static struct table_entry *
1947 xlfd_lookup_field_contents (table, dim, font, field_index)
1948 struct table_entry *table;
1949 int dim;
1950 struct font_name *font;
1951 int field_index;
1953 /* Function split_font_name converts fields to lower-case, so there
1954 is no need to use xstrlwr or xstricmp here. */
1955 char *s = font->fields[field_index];
1956 int low, mid, high, cmp;
1958 low = 0;
1959 high = dim - 1;
1961 while (low <= high)
1963 mid = (low + high) / 2;
1964 cmp = strcmp (table[mid].name, s);
1966 if (cmp < 0)
1967 low = mid + 1;
1968 else if (cmp > 0)
1969 high = mid - 1;
1970 else
1971 return table + mid;
1974 return NULL;
1978 /* Return a numeric representation for font name field
1979 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1980 has DIM entries. Value is the numeric value found or DFLT if no
1981 table entry matches. This function is used to translate weight,
1982 slant, and swidth names of XLFD font names to numeric values. */
1984 static INLINE int
1985 xlfd_numeric_value (table, dim, font, field_index, dflt)
1986 struct table_entry *table;
1987 int dim;
1988 struct font_name *font;
1989 int field_index;
1990 int dflt;
1992 struct table_entry *p;
1993 p = xlfd_lookup_field_contents (table, dim, font, field_index);
1994 return p ? p->numeric : dflt;
1998 /* Return a symbolic representation for font name field
1999 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2000 has DIM entries. Value is the symbolic value found or DFLT if no
2001 table entry matches. This function is used to translate weight,
2002 slant, and swidth names of XLFD font names to symbols. */
2004 static INLINE Lisp_Object
2005 xlfd_symbolic_value (table, dim, font, field_index, dflt)
2006 struct table_entry *table;
2007 int dim;
2008 struct font_name *font;
2009 int field_index;
2010 Lisp_Object dflt;
2012 struct table_entry *p;
2013 p = xlfd_lookup_field_contents (table, dim, font, field_index);
2014 return p ? *p->symbol : dflt;
2018 /* Return a numeric value for the slant of the font given by FONT. */
2020 static INLINE int
2021 xlfd_numeric_slant (font)
2022 struct font_name *font;
2024 return xlfd_numeric_value (slant_table, DIM (slant_table),
2025 font, XLFD_SLANT, XLFD_SLANT_ROMAN);
2029 /* Return a symbol representing the weight of the font given by FONT. */
2031 static INLINE Lisp_Object
2032 xlfd_symbolic_slant (font)
2033 struct font_name *font;
2035 return xlfd_symbolic_value (slant_table, DIM (slant_table),
2036 font, XLFD_SLANT, Qnormal);
2040 /* Return a numeric value for the weight of the font given by FONT. */
2042 static INLINE int
2043 xlfd_numeric_weight (font)
2044 struct font_name *font;
2046 return xlfd_numeric_value (weight_table, DIM (weight_table),
2047 font, XLFD_WEIGHT, XLFD_WEIGHT_MEDIUM);
2051 /* Return a symbol representing the slant of the font given by FONT. */
2053 static INLINE Lisp_Object
2054 xlfd_symbolic_weight (font)
2055 struct font_name *font;
2057 return xlfd_symbolic_value (weight_table, DIM (weight_table),
2058 font, XLFD_WEIGHT, Qnormal);
2062 /* Return a numeric value for the swidth of the font whose XLFD font
2063 name fields are found in FONT. */
2065 static INLINE int
2066 xlfd_numeric_swidth (font)
2067 struct font_name *font;
2069 return xlfd_numeric_value (swidth_table, DIM (swidth_table),
2070 font, XLFD_SWIDTH, XLFD_SWIDTH_MEDIUM);
2074 /* Return a symbolic value for the swidth of FONT. */
2076 static INLINE Lisp_Object
2077 xlfd_symbolic_swidth (font)
2078 struct font_name *font;
2080 return xlfd_symbolic_value (swidth_table, DIM (swidth_table),
2081 font, XLFD_SWIDTH, Qnormal);
2085 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2086 entries. Value is a pointer to the matching table entry or null if
2087 no element of TABLE contains SYMBOL. */
2089 static struct table_entry *
2090 face_value (table, dim, symbol)
2091 struct table_entry *table;
2092 int dim;
2093 Lisp_Object symbol;
2095 int i;
2097 xassert (SYMBOLP (symbol));
2099 for (i = 0; i < dim; ++i)
2100 if (EQ (*table[i].symbol, symbol))
2101 break;
2103 return i < dim ? table + i : NULL;
2107 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2108 entries. Value is -1 if SYMBOL is not found in TABLE. */
2110 static INLINE int
2111 face_numeric_value (table, dim, symbol)
2112 struct table_entry *table;
2113 int dim;
2114 Lisp_Object symbol;
2116 struct table_entry *p = face_value (table, dim, symbol);
2117 return p ? p->numeric : -1;
2121 /* Return a numeric value representing the weight specified by Lisp
2122 symbol WEIGHT. Value is one of the enumerators of enum
2123 xlfd_weight. */
2125 static INLINE int
2126 face_numeric_weight (weight)
2127 Lisp_Object weight;
2129 return face_numeric_value (weight_table, DIM (weight_table), weight);
2133 /* Return a numeric value representing the slant specified by Lisp
2134 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2136 static INLINE int
2137 face_numeric_slant (slant)
2138 Lisp_Object slant;
2140 return face_numeric_value (slant_table, DIM (slant_table), slant);
2144 /* Return a numeric value representing the swidth specified by Lisp
2145 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2147 static int
2148 face_numeric_swidth (width)
2149 Lisp_Object width;
2151 return face_numeric_value (swidth_table, DIM (swidth_table), width);
2155 #ifdef HAVE_WINDOW_SYSTEM
2157 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2159 static INLINE int
2160 xlfd_fixed_p (font)
2161 struct font_name *font;
2163 /* Function split_font_name converts fields to lower-case, so there
2164 is no need to use tolower here. */
2165 return *font->fields[XLFD_SPACING] != 'p';
2169 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2171 The actual height of the font when displayed on F depends on the
2172 resolution of both the font and frame. For example, a 10pt font
2173 designed for a 100dpi display will display larger than 10pt on a
2174 75dpi display. (It's not unusual to use fonts not designed for the
2175 display one is using. For example, some intlfonts are available in
2176 72dpi versions, only.)
2178 Value is the real point size of FONT on frame F, or 0 if it cannot
2179 be determined. */
2181 static INLINE int
2182 xlfd_point_size (f, font)
2183 struct frame *f;
2184 struct font_name *font;
2186 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
2187 char *pixel_field = font->fields[XLFD_PIXEL_SIZE];
2188 double pixel;
2189 int real_pt;
2191 if (*pixel_field == '[')
2193 /* The pixel size field is `[A B C D]' which specifies
2194 a transformation matrix.
2196 A B 0
2197 C D 0
2198 0 0 1
2200 by which all glyphs of the font are transformed. The spec
2201 says that s scalar value N for the pixel size is equivalent
2202 to A = N * resx/resy, B = C = 0, D = N. */
2203 char *start = pixel_field + 1, *end;
2204 double matrix[4];
2205 int i;
2207 for (i = 0; i < 4; ++i)
2209 matrix[i] = strtod (start, &end);
2210 start = end;
2213 pixel = matrix[3];
2215 else
2216 pixel = atoi (pixel_field);
2218 if (pixel == 0)
2219 real_pt = 0;
2220 else
2221 real_pt = PT_PER_INCH * 10.0 * pixel / resy + 0.5;
2223 return real_pt;
2227 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2228 of frame F. This function is used to guess a point size of font
2229 when only the pixel height of the font is available. */
2231 static INLINE int
2232 pixel_point_size (f, pixel)
2233 struct frame *f;
2234 int pixel;
2236 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
2237 double real_pt;
2238 int int_pt;
2240 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2241 point size of one dot. */
2242 real_pt = pixel * PT_PER_INCH / resy;
2243 int_pt = real_pt + 0.5;
2245 return int_pt;
2249 /* Return a rescaling ratio of a font of NAME. */
2251 static double
2252 font_rescale_ratio (name)
2253 char *name;
2255 Lisp_Object tail, elt;
2257 for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
2259 elt = XCAR (tail);
2260 if (STRINGP (XCAR (elt)) && FLOATP (XCDR (elt))
2261 && fast_c_string_match_ignore_case (XCAR (elt), name) >= 0)
2262 return XFLOAT_DATA (XCDR (elt));
2264 return 1.0;
2268 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2269 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2270 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2271 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2272 zero if the font name doesn't have the format we expect. The
2273 expected format is a font name that starts with a `-' and has
2274 XLFD_LAST fields separated by `-'. */
2276 static int
2277 split_font_name (f, font, numeric_p)
2278 struct frame *f;
2279 struct font_name *font;
2280 int numeric_p;
2282 int i = 0;
2283 int success_p;
2284 double rescale_ratio;
2286 if (numeric_p)
2287 /* This must be done before splitting the font name. */
2288 rescale_ratio = font_rescale_ratio (font->name);
2290 if (*font->name == '-')
2292 char *p = xstrlwr (font->name) + 1;
2294 while (i < XLFD_LAST)
2296 font->fields[i] = p;
2297 ++i;
2299 /* Pixel and point size may be of the form `[....]'. For
2300 BNF, see XLFD spec, chapter 4. Negative values are
2301 indicated by tilde characters which we replace with
2302 `-' characters, here. */
2303 if (*p == '['
2304 && (i - 1 == XLFD_PIXEL_SIZE
2305 || i - 1 == XLFD_POINT_SIZE))
2307 char *start, *end;
2308 int j;
2310 for (++p; *p && *p != ']'; ++p)
2311 if (*p == '~')
2312 *p = '-';
2314 /* Check that the matrix contains 4 floating point
2315 numbers. */
2316 for (j = 0, start = font->fields[i - 1] + 1;
2317 j < 4;
2318 ++j, start = end)
2319 if (strtod (start, &end) == 0 && start == end)
2320 break;
2322 if (j < 4)
2323 break;
2326 while (*p && *p != '-')
2327 ++p;
2329 if (*p != '-')
2330 break;
2332 *p++ = 0;
2336 success_p = i == XLFD_LAST;
2338 /* If requested, and font name was in the expected format,
2339 compute numeric values for some fields. */
2340 if (numeric_p && success_p)
2342 font->numeric[XLFD_POINT_SIZE] = xlfd_point_size (f, font);
2343 font->numeric[XLFD_RESY] = atoi (font->fields[XLFD_RESY]);
2344 font->numeric[XLFD_SLANT] = xlfd_numeric_slant (font);
2345 font->numeric[XLFD_WEIGHT] = xlfd_numeric_weight (font);
2346 font->numeric[XLFD_SWIDTH] = xlfd_numeric_swidth (font);
2347 font->numeric[XLFD_AVGWIDTH] = atoi (font->fields[XLFD_AVGWIDTH]);
2348 font->rescale_ratio = rescale_ratio;
2351 /* Initialize it to zero. It will be overridden by font_list while
2352 trying alternate registries. */
2353 font->registry_priority = 0;
2355 return success_p;
2359 /* Build an XLFD font name from font name fields in FONT. Value is a
2360 pointer to the font name, which is allocated via xmalloc. */
2362 static char *
2363 build_font_name (font)
2364 struct font_name *font;
2366 int i;
2367 int size = 100;
2368 char *font_name = (char *) xmalloc (size);
2369 int total_length = 0;
2371 for (i = 0; i < XLFD_LAST; ++i)
2373 /* Add 1 because of the leading `-'. */
2374 int len = strlen (font->fields[i]) + 1;
2376 /* Reallocate font_name if necessary. Add 1 for the final
2377 NUL-byte. */
2378 if (total_length + len + 1 >= size)
2380 int new_size = max (2 * size, size + len + 1);
2381 int sz = new_size * sizeof *font_name;
2382 font_name = (char *) xrealloc (font_name, sz);
2383 size = new_size;
2386 font_name[total_length] = '-';
2387 bcopy (font->fields[i], font_name + total_length + 1, len - 1);
2388 total_length += len;
2391 font_name[total_length] = 0;
2392 return font_name;
2396 /* Free an array FONTS of N font_name structures. This frees FONTS
2397 itself and all `name' fields in its elements. */
2399 static INLINE void
2400 free_font_names (fonts, n)
2401 struct font_name *fonts;
2402 int n;
2404 while (n)
2405 xfree (fonts[--n].name);
2406 xfree (fonts);
2410 /* Sort vector FONTS of font_name structures which contains NFONTS
2411 elements using qsort and comparison function CMPFN. F is the frame
2412 on which the fonts will be used. The global variable font_frame
2413 is temporarily set to F to make it available in CMPFN. */
2415 static INLINE void
2416 sort_fonts (f, fonts, nfonts, cmpfn)
2417 struct frame *f;
2418 struct font_name *fonts;
2419 int nfonts;
2420 int (*cmpfn) P_ ((const void *, const void *));
2422 font_frame = f;
2423 qsort (fonts, nfonts, sizeof *fonts, cmpfn);
2424 font_frame = NULL;
2428 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2429 display in x_display_list. FONTS is a pointer to a vector of
2430 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2431 alternative patterns from Valternate_fontname_alist if no fonts are
2432 found matching PATTERN.
2434 For all fonts found, set FONTS[i].name to the name of the font,
2435 allocated via xmalloc, and split font names into fields. Ignore
2436 fonts that we can't parse. Value is the number of fonts found. */
2438 static int
2439 x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p)
2440 struct frame *f;
2441 char *pattern;
2442 struct font_name **pfonts;
2443 int nfonts, try_alternatives_p;
2445 int n, nignored;
2447 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2448 better to do it the other way around. */
2449 Lisp_Object lfonts;
2450 Lisp_Object lpattern, tem;
2451 struct font_name *fonts = 0;
2452 int num_fonts = nfonts;
2454 *pfonts = 0;
2455 lpattern = build_string (pattern);
2457 /* Get the list of fonts matching PATTERN. */
2458 #ifdef WINDOWSNT
2459 BLOCK_INPUT;
2460 lfonts = w32_list_fonts (f, lpattern, 0, nfonts);
2461 UNBLOCK_INPUT;
2462 #else
2463 lfonts = x_list_fonts (f, lpattern, -1, nfonts);
2464 #endif
2466 if (nfonts < 0 && CONSP (lfonts))
2467 num_fonts = XFASTINT (Flength (lfonts));
2469 /* Make a copy of the font names we got from X, and
2470 split them into fields. */
2471 n = nignored = 0;
2472 for (tem = lfonts; CONSP (tem) && n < num_fonts; tem = XCDR (tem))
2474 Lisp_Object elt, tail;
2475 const char *name = SDATA (XCAR (tem));
2477 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2478 for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail))
2480 elt = XCAR (tail);
2481 if (STRINGP (elt)
2482 && fast_c_string_match_ignore_case (elt, name) >= 0)
2483 break;
2485 if (!NILP (tail))
2487 ++nignored;
2488 continue;
2491 if (! fonts)
2493 *pfonts = (struct font_name *) xmalloc (num_fonts * sizeof **pfonts);
2494 fonts = *pfonts;
2497 /* Make a copy of the font name. */
2498 fonts[n].name = xstrdup (name);
2500 if (split_font_name (f, fonts + n, 1))
2502 if (font_scalable_p (fonts + n)
2503 && !may_use_scalable_font_p (name))
2505 ++nignored;
2506 xfree (fonts[n].name);
2508 else
2509 ++n;
2511 else
2512 xfree (fonts[n].name);
2515 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2516 if (n == 0 && try_alternatives_p)
2518 Lisp_Object list = Valternate_fontname_alist;
2520 if (*pfonts)
2522 xfree (*pfonts);
2523 *pfonts = 0;
2526 while (CONSP (list))
2528 Lisp_Object entry = XCAR (list);
2529 if (CONSP (entry)
2530 && STRINGP (XCAR (entry))
2531 && strcmp (SDATA (XCAR (entry)), pattern) == 0)
2532 break;
2533 list = XCDR (list);
2536 if (CONSP (list))
2538 Lisp_Object patterns = XCAR (list);
2539 Lisp_Object name;
2541 while (CONSP (patterns)
2542 /* If list is screwed up, give up. */
2543 && (name = XCAR (patterns),
2544 STRINGP (name))
2545 /* Ignore patterns equal to PATTERN because we tried that
2546 already with no success. */
2547 && (strcmp (SDATA (name), pattern) == 0
2548 || (n = x_face_list_fonts (f, SDATA (name),
2549 pfonts, nfonts, 0),
2550 n == 0)))
2551 patterns = XCDR (patterns);
2555 return n;
2559 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2560 using comparison function CMPFN. Value is the number of fonts
2561 found. If value is non-zero, *FONTS is set to a vector of
2562 font_name structures allocated from the heap containing matching
2563 fonts. Each element of *FONTS contains a name member that is also
2564 allocated from the heap. Font names in these structures are split
2565 into fields. Use free_font_names to free such an array. */
2567 static int
2568 sorted_font_list (f, pattern, cmpfn, fonts)
2569 struct frame *f;
2570 char *pattern;
2571 int (*cmpfn) P_ ((const void *, const void *));
2572 struct font_name **fonts;
2574 int nfonts;
2576 /* Get the list of fonts matching pattern. 100 should suffice. */
2577 nfonts = DEFAULT_FONT_LIST_LIMIT;
2578 if (INTEGERP (Vfont_list_limit))
2579 nfonts = XINT (Vfont_list_limit);
2581 *fonts = NULL;
2582 nfonts = x_face_list_fonts (f, pattern, fonts, nfonts, 1);
2584 /* Sort the resulting array and return it in *FONTS. If no
2585 fonts were found, make sure to set *FONTS to null. */
2586 if (nfonts)
2587 sort_fonts (f, *fonts, nfonts, cmpfn);
2588 else if (*fonts)
2590 xfree (*fonts);
2591 *fonts = NULL;
2594 return nfonts;
2598 /* Compare two font_name structures *A and *B. Value is analogous to
2599 strcmp. Sort order is given by the global variable
2600 font_sort_order. Font names are sorted so that, everything else
2601 being equal, fonts with a resolution closer to that of the frame on
2602 which they are used are listed first. The global variable
2603 font_frame is the frame on which we operate. */
2605 static int
2606 cmp_font_names (a, b)
2607 const void *a, *b;
2609 struct font_name *x = (struct font_name *) a;
2610 struct font_name *y = (struct font_name *) b;
2611 int cmp;
2613 /* All strings have been converted to lower-case by split_font_name,
2614 so we can use strcmp here. */
2615 cmp = strcmp (x->fields[XLFD_FAMILY], y->fields[XLFD_FAMILY]);
2616 if (cmp == 0)
2618 int i;
2620 for (i = 0; i < DIM (font_sort_order) && cmp == 0; ++i)
2622 int j = font_sort_order[i];
2623 cmp = x->numeric[j] - y->numeric[j];
2626 if (cmp == 0)
2628 /* Everything else being equal, we prefer fonts with an
2629 y-resolution closer to that of the frame. */
2630 int resy = FRAME_X_DISPLAY_INFO (font_frame)->resy;
2631 int x_resy = x->numeric[XLFD_RESY];
2632 int y_resy = y->numeric[XLFD_RESY];
2633 cmp = abs (resy - x_resy) - abs (resy - y_resy);
2637 return cmp;
2641 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2642 is non-nil list fonts matching that pattern. Otherwise, if
2643 REGISTRY is non-nil return only fonts with that registry, otherwise
2644 return fonts of any registry. Set *FONTS to a vector of font_name
2645 structures allocated from the heap containing the fonts found.
2646 Value is the number of fonts found. */
2648 static int
2649 font_list_1 (f, pattern, family, registry, fonts)
2650 struct frame *f;
2651 Lisp_Object pattern, family, registry;
2652 struct font_name **fonts;
2654 char *pattern_str, *family_str, *registry_str;
2656 if (NILP (pattern))
2658 family_str = (NILP (family) ? "*" : (char *) SDATA (family));
2659 registry_str = (NILP (registry) ? "*" : (char *) SDATA (registry));
2661 pattern_str = (char *) alloca (strlen (family_str)
2662 + strlen (registry_str)
2663 + 10);
2664 strcpy (pattern_str, index (family_str, '-') ? "-" : "-*-");
2665 strcat (pattern_str, family_str);
2666 strcat (pattern_str, "-*-");
2667 strcat (pattern_str, registry_str);
2668 if (!index (registry_str, '-'))
2670 if (registry_str[strlen (registry_str) - 1] == '*')
2671 strcat (pattern_str, "-*");
2672 else
2673 strcat (pattern_str, "*-*");
2676 else
2677 pattern_str = (char *) SDATA (pattern);
2679 return sorted_font_list (f, pattern_str, cmp_font_names, fonts);
2683 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2684 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2685 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2686 freed. */
2688 static struct font_name *
2689 concat_font_list (fonts1, nfonts1, fonts2, nfonts2)
2690 struct font_name *fonts1, *fonts2;
2691 int nfonts1, nfonts2;
2693 int new_nfonts = nfonts1 + nfonts2;
2694 struct font_name *new_fonts;
2696 new_fonts = (struct font_name *) xmalloc (sizeof *new_fonts * new_nfonts);
2697 bcopy (fonts1, new_fonts, sizeof *new_fonts * nfonts1);
2698 bcopy (fonts2, new_fonts + nfonts1, sizeof *new_fonts * nfonts2);
2699 xfree (fonts1);
2700 xfree (fonts2);
2701 return new_fonts;
2705 /* Get a sorted list of fonts of family FAMILY on frame F.
2707 If PATTERN is non-nil list fonts matching that pattern.
2709 If REGISTRY is non-nil, return fonts with that registry and the
2710 alternative registries from Vface_alternative_font_registry_alist.
2712 If REGISTRY is nil return fonts of any registry.
2714 Set *FONTS to a vector of font_name structures allocated from the
2715 heap containing the fonts found. Value is the number of fonts
2716 found. */
2718 static int
2719 font_list (f, pattern, family, registry, fonts)
2720 struct frame *f;
2721 Lisp_Object pattern, family, registry;
2722 struct font_name **fonts;
2724 int nfonts = font_list_1 (f, pattern, family, registry, fonts);
2726 if (!NILP (registry)
2727 && CONSP (Vface_alternative_font_registry_alist))
2729 Lisp_Object alter;
2731 alter = Fassoc (registry, Vface_alternative_font_registry_alist);
2732 if (CONSP (alter))
2734 int reg_prio, i;
2736 for (alter = XCDR (alter), reg_prio = 1;
2737 CONSP (alter);
2738 alter = XCDR (alter), reg_prio++)
2739 if (STRINGP (XCAR (alter)))
2741 int nfonts2;
2742 struct font_name *fonts2;
2744 nfonts2 = font_list_1 (f, pattern, family, XCAR (alter),
2745 &fonts2);
2746 for (i = 0; i < nfonts2; i++)
2747 fonts2[i].registry_priority = reg_prio;
2748 *fonts = (nfonts > 0
2749 ? concat_font_list (*fonts, nfonts, fonts2, nfonts2)
2750 : fonts2);
2751 nfonts += nfonts2;
2756 return nfonts;
2760 /* Remove elements from LIST whose cars are `equal'. Called from
2761 x-family-fonts and x-font-family-list to remove duplicate font
2762 entries. */
2764 static void
2765 remove_duplicates (list)
2766 Lisp_Object list;
2768 Lisp_Object tail = list;
2770 while (!NILP (tail) && !NILP (XCDR (tail)))
2772 Lisp_Object next = XCDR (tail);
2773 if (!NILP (Fequal (XCAR (next), XCAR (tail))))
2774 XSETCDR (tail, XCDR (next));
2775 else
2776 tail = XCDR (tail);
2781 DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
2782 doc: /* Return a list of available fonts of family FAMILY on FRAME.
2783 If FAMILY is omitted or nil, list all families.
2784 Otherwise, FAMILY must be a string, possibly containing wildcards
2785 `?' and `*'.
2786 If FRAME is omitted or nil, use the selected frame.
2787 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2788 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2789 FAMILY is the font family name. POINT-SIZE is the size of the
2790 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2791 width, weight and slant of the font. These symbols are the same as for
2792 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2793 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2794 giving the registry and encoding of the font.
2795 The result list is sorted according to the current setting of
2796 the face font sort order. */)
2797 (family, frame)
2798 Lisp_Object family, frame;
2800 struct frame *f = check_x_frame (frame);
2801 struct font_name *fonts;
2802 int i, nfonts;
2803 Lisp_Object result;
2804 struct gcpro gcpro1;
2806 if (!NILP (family))
2807 CHECK_STRING (family);
2809 result = Qnil;
2810 GCPRO1 (result);
2811 nfonts = font_list (f, Qnil, family, Qnil, &fonts);
2812 for (i = nfonts - 1; i >= 0; --i)
2814 Lisp_Object v = Fmake_vector (make_number (8), Qnil);
2815 char *tem;
2817 ASET (v, 0, build_string (fonts[i].fields[XLFD_FAMILY]));
2818 ASET (v, 1, xlfd_symbolic_swidth (fonts + i));
2819 ASET (v, 2, make_number (xlfd_point_size (f, fonts + i)));
2820 ASET (v, 3, xlfd_symbolic_weight (fonts + i));
2821 ASET (v, 4, xlfd_symbolic_slant (fonts + i));
2822 ASET (v, 5, xlfd_fixed_p (fonts + i) ? Qt : Qnil);
2823 tem = build_font_name (fonts + i);
2824 ASET (v, 6, build_string (tem));
2825 sprintf (tem, "%s-%s", fonts[i].fields[XLFD_REGISTRY],
2826 fonts[i].fields[XLFD_ENCODING]);
2827 ASET (v, 7, build_string (tem));
2828 xfree (tem);
2830 result = Fcons (v, result);
2833 remove_duplicates (result);
2834 free_font_names (fonts, nfonts);
2835 UNGCPRO;
2836 return result;
2840 DEFUN ("x-font-family-list", Fx_font_family_list, Sx_font_family_list,
2841 0, 1, 0,
2842 doc: /* Return a list of available font families on FRAME.
2843 If FRAME is omitted or nil, use the selected frame.
2844 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2845 is a font family, and FIXED-P is non-nil if fonts of that family
2846 are fixed-pitch. */)
2847 (frame)
2848 Lisp_Object frame;
2850 struct frame *f = check_x_frame (frame);
2851 int nfonts, i;
2852 struct font_name *fonts;
2853 Lisp_Object result;
2854 struct gcpro gcpro1;
2855 int count = SPECPDL_INDEX ();
2857 /* Let's consider all fonts. */
2858 specbind (intern ("font-list-limit"), make_number (-1));
2859 nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
2861 result = Qnil;
2862 GCPRO1 (result);
2863 for (i = nfonts - 1; i >= 0; --i)
2864 result = Fcons (Fcons (build_string (fonts[i].fields[XLFD_FAMILY]),
2865 xlfd_fixed_p (fonts + i) ? Qt : Qnil),
2866 result);
2868 remove_duplicates (result);
2869 free_font_names (fonts, nfonts);
2870 UNGCPRO;
2871 return unbind_to (count, result);
2875 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
2876 doc: /* Return a list of the names of available fonts matching PATTERN.
2877 If optional arguments FACE and FRAME are specified, return only fonts
2878 the same size as FACE on FRAME.
2879 PATTERN is a string, perhaps with wildcard characters;
2880 the * character matches any substring, and
2881 the ? character matches any single character.
2882 PATTERN is case-insensitive.
2883 FACE is a face name--a symbol.
2885 The return value is a list of strings, suitable as arguments to
2886 set-face-font.
2888 Fonts Emacs can't use may or may not be excluded
2889 even if they match PATTERN and FACE.
2890 The optional fourth argument MAXIMUM sets a limit on how many
2891 fonts to match. The first MAXIMUM fonts are reported.
2892 The optional fifth argument WIDTH, if specified, is a number of columns
2893 occupied by a character of a font. In that case, return only fonts
2894 the WIDTH times as wide as FACE on FRAME. */)
2895 (pattern, face, frame, maximum, width)
2896 Lisp_Object pattern, face, frame, maximum, width;
2898 struct frame *f;
2899 int size;
2900 int maxnames;
2902 check_x ();
2903 CHECK_STRING (pattern);
2905 if (NILP (maximum))
2906 maxnames = -1;
2907 else
2909 CHECK_NATNUM (maximum);
2910 maxnames = XINT (maximum);
2913 if (!NILP (width))
2914 CHECK_NUMBER (width);
2916 /* We can't simply call check_x_frame because this function may be
2917 called before any frame is created. */
2918 f = frame_or_selected_frame (frame, 2);
2919 if (!FRAME_WINDOW_P (f))
2921 /* Perhaps we have not yet created any frame. */
2922 f = NULL;
2923 face = Qnil;
2926 /* Determine the width standard for comparison with the fonts we find. */
2928 if (NILP (face))
2929 size = 0;
2930 else
2932 /* This is of limited utility since it works with character
2933 widths. Keep it for compatibility. --gerd. */
2934 int face_id = lookup_named_face (f, face, 0);
2935 struct face *face = (face_id < 0
2936 ? NULL
2937 : FACE_FROM_ID (f, face_id));
2939 #ifdef WINDOWSNT
2940 /* For historic reasons, FONT_WIDTH refers to average width on W32,
2941 not maximum as on X. Redefine here. */
2942 #undef FONT_WIDTH
2943 #define FONT_WIDTH FONT_MAX_WIDTH
2944 #endif
2946 if (face && face->font)
2947 size = FONT_WIDTH (face->font);
2948 else
2949 size = FONT_WIDTH (FRAME_FONT (f)); /* FRAME_COLUMN_WIDTH (f) */
2951 if (!NILP (width))
2952 size *= XINT (width);
2956 Lisp_Object args[2];
2958 args[0] = x_list_fonts (f, pattern, size, maxnames);
2959 if (f == NULL)
2960 /* We don't have to check fontsets. */
2961 return args[0];
2962 args[1] = list_fontsets (f, pattern, size);
2963 return Fnconc (2, args);
2967 #endif /* HAVE_WINDOW_SYSTEM */
2971 /***********************************************************************
2972 Lisp Faces
2973 ***********************************************************************/
2975 /* Access face attributes of face LFACE, a Lisp vector. */
2977 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2978 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2979 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2980 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2981 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2982 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2983 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2984 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2985 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2986 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2987 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2988 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2989 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2990 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2991 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2992 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2994 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2995 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2997 #define LFACEP(LFACE) \
2998 (VECTORP (LFACE) \
2999 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3000 && EQ (AREF (LFACE, 0), Qface))
3003 #if GLYPH_DEBUG
3005 /* Check consistency of Lisp face attribute vector ATTRS. */
3007 static void
3008 check_lface_attrs (attrs)
3009 Lisp_Object *attrs;
3011 xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
3012 || STRINGP (attrs[LFACE_FAMILY_INDEX]));
3013 xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
3014 || SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
3015 xassert (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])
3016 || INTEGERP (attrs[LFACE_AVGWIDTH_INDEX]));
3017 xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
3018 || INTEGERP (attrs[LFACE_HEIGHT_INDEX])
3019 || FLOATP (attrs[LFACE_HEIGHT_INDEX])
3020 || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX]));
3021 xassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
3022 || SYMBOLP (attrs[LFACE_WEIGHT_INDEX]));
3023 xassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
3024 || SYMBOLP (attrs[LFACE_SLANT_INDEX]));
3025 xassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
3026 || SYMBOLP (attrs[LFACE_UNDERLINE_INDEX])
3027 || STRINGP (attrs[LFACE_UNDERLINE_INDEX]));
3028 xassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
3029 || SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
3030 || STRINGP (attrs[LFACE_OVERLINE_INDEX]));
3031 xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
3032 || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
3033 || STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX]));
3034 xassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
3035 || SYMBOLP (attrs[LFACE_BOX_INDEX])
3036 || STRINGP (attrs[LFACE_BOX_INDEX])
3037 || INTEGERP (attrs[LFACE_BOX_INDEX])
3038 || CONSP (attrs[LFACE_BOX_INDEX]));
3039 xassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
3040 || SYMBOLP (attrs[LFACE_INVERSE_INDEX]));
3041 xassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
3042 || STRINGP (attrs[LFACE_FOREGROUND_INDEX]));
3043 xassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
3044 || STRINGP (attrs[LFACE_BACKGROUND_INDEX]));
3045 xassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
3046 || NILP (attrs[LFACE_INHERIT_INDEX])
3047 || SYMBOLP (attrs[LFACE_INHERIT_INDEX])
3048 || CONSP (attrs[LFACE_INHERIT_INDEX]));
3049 #ifdef HAVE_WINDOW_SYSTEM
3050 xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
3051 || SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
3052 || !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
3053 xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
3054 || NILP (attrs[LFACE_FONT_INDEX])
3055 || STRINGP (attrs[LFACE_FONT_INDEX]));
3056 #endif
3060 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3062 static void
3063 check_lface (lface)
3064 Lisp_Object lface;
3066 if (!NILP (lface))
3068 xassert (LFACEP (lface));
3069 check_lface_attrs (XVECTOR (lface)->contents);
3073 #else /* GLYPH_DEBUG == 0 */
3075 #define check_lface_attrs(attrs) (void) 0
3076 #define check_lface(lface) (void) 0
3078 #endif /* GLYPH_DEBUG == 0 */
3081 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3082 to make it a symvol. If FACE_NAME is an alias for another face,
3083 return that face's name. */
3085 static Lisp_Object
3086 resolve_face_name (face_name)
3087 Lisp_Object face_name;
3089 Lisp_Object aliased;
3091 if (STRINGP (face_name))
3092 face_name = intern (SDATA (face_name));
3094 while (SYMBOLP (face_name))
3096 aliased = Fget (face_name, Qface_alias);
3097 if (NILP (aliased))
3098 break;
3099 else
3100 face_name = aliased;
3103 return face_name;
3107 /* Return the face definition of FACE_NAME on frame F. F null means
3108 return the definition for new frames. FACE_NAME may be a string or
3109 a symbol (apparently Emacs 20.2 allowed strings as face names in
3110 face text properties; Ediff uses that). If FACE_NAME is an alias
3111 for another face, return that face's definition. If SIGNAL_P is
3112 non-zero, signal an error if FACE_NAME is not a valid face name.
3113 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3114 name. */
3116 static INLINE Lisp_Object
3117 lface_from_face_name (f, face_name, signal_p)
3118 struct frame *f;
3119 Lisp_Object face_name;
3120 int signal_p;
3122 Lisp_Object lface;
3124 face_name = resolve_face_name (face_name);
3126 if (f)
3127 lface = assq_no_quit (face_name, f->face_alist);
3128 else
3129 lface = assq_no_quit (face_name, Vface_new_frame_defaults);
3131 if (CONSP (lface))
3132 lface = XCDR (lface);
3133 else if (signal_p)
3134 signal_error ("Invalid face", face_name);
3136 check_lface (lface);
3137 return lface;
3141 /* Get face attributes of face FACE_NAME from frame-local faces on
3142 frame F. Store the resulting attributes in ATTRS which must point
3143 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3144 is non-zero, signal an error if FACE_NAME does not name a face.
3145 Otherwise, value is zero if FACE_NAME is not a face. */
3147 static INLINE int
3148 get_lface_attributes (f, face_name, attrs, signal_p)
3149 struct frame *f;
3150 Lisp_Object face_name;
3151 Lisp_Object *attrs;
3152 int signal_p;
3154 Lisp_Object lface;
3155 int success_p;
3157 lface = lface_from_face_name (f, face_name, signal_p);
3158 if (!NILP (lface))
3160 bcopy (XVECTOR (lface)->contents, attrs,
3161 LFACE_VECTOR_SIZE * sizeof *attrs);
3162 success_p = 1;
3164 else
3165 success_p = 0;
3167 return success_p;
3171 /* Non-zero if all attributes in face attribute vector ATTRS are
3172 specified, i.e. are non-nil. */
3174 static int
3175 lface_fully_specified_p (attrs)
3176 Lisp_Object *attrs;
3178 int i;
3180 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3181 if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
3182 && i != LFACE_AVGWIDTH_INDEX)
3183 if (UNSPECIFIEDP (attrs[i]))
3184 break;
3186 return i == LFACE_VECTOR_SIZE;
3189 #ifdef HAVE_WINDOW_SYSTEM
3191 /* Set font-related attributes of Lisp face LFACE from the fullname of
3192 the font opened by FONTNAME. If FORCE_P is zero, set only
3193 unspecified attributes of LFACE. The exception is `font'
3194 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3196 If FONTNAME is not available on frame F,
3197 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3198 If the fullname is not in a valid XLFD format,
3199 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3200 in LFACE and return 1.
3201 Otherwise, return 1. */
3203 static int
3204 set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p)
3205 struct frame *f;
3206 Lisp_Object lface;
3207 Lisp_Object fontname;
3208 int force_p, may_fail_p;
3210 struct font_name font;
3211 char *buffer;
3212 int pt;
3213 int have_xlfd_p;
3214 int fontset;
3215 char *font_name = SDATA (fontname);
3216 struct font_info *font_info;
3218 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3219 fontset = fs_query_fontset (fontname, 0);
3220 if (fontset >= 0)
3221 font_name = SDATA (fontset_ascii (fontset));
3223 /* Check if FONT_NAME is surely available on the system. Usually
3224 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3225 returns quickly. But, even if FONT_NAME is not yet cached,
3226 caching it now is not futail because we anyway load the font
3227 later. */
3228 BLOCK_INPUT;
3229 font_info = FS_LOAD_FONT (f, 0, font_name, -1);
3230 UNBLOCK_INPUT;
3232 if (!font_info)
3234 if (may_fail_p)
3235 return 0;
3236 abort ();
3239 font.name = STRDUPA (font_info->full_name);
3240 have_xlfd_p = split_font_name (f, &font, 1);
3242 /* Set attributes only if unspecified, otherwise face defaults for
3243 new frames would never take effect. If we couldn't get a font
3244 name conforming to XLFD, set normal values. */
3246 if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
3248 Lisp_Object val;
3249 if (have_xlfd_p)
3251 buffer = (char *) alloca (strlen (font.fields[XLFD_FAMILY])
3252 + strlen (font.fields[XLFD_FOUNDRY])
3253 + 2);
3254 sprintf (buffer, "%s-%s", font.fields[XLFD_FOUNDRY],
3255 font.fields[XLFD_FAMILY]);
3256 val = build_string (buffer);
3258 else
3259 val = build_string ("*");
3260 LFACE_FAMILY (lface) = val;
3263 if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
3265 if (have_xlfd_p)
3266 pt = xlfd_point_size (f, &font);
3267 else
3268 pt = pixel_point_size (f, font_info->height * 10);
3269 xassert (pt > 0);
3270 LFACE_HEIGHT (lface) = make_number (pt);
3273 if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
3274 LFACE_SWIDTH (lface)
3275 = have_xlfd_p ? xlfd_symbolic_swidth (&font) : Qnormal;
3277 if (force_p || UNSPECIFIEDP (LFACE_AVGWIDTH (lface)))
3278 LFACE_AVGWIDTH (lface)
3279 = (have_xlfd_p
3280 ? make_number (font.numeric[XLFD_AVGWIDTH])
3281 : Qunspecified);
3283 if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
3284 LFACE_WEIGHT (lface)
3285 = have_xlfd_p ? xlfd_symbolic_weight (&font) : Qnormal;
3287 if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
3288 LFACE_SLANT (lface)
3289 = have_xlfd_p ? xlfd_symbolic_slant (&font) : Qnormal;
3291 LFACE_FONT (lface) = fontname;
3293 return 1;
3296 #endif /* HAVE_WINDOW_SYSTEM */
3299 /* Merges the face height FROM with the face height TO, and returns the
3300 merged height. If FROM is an invalid height, then INVALID is
3301 returned instead. FROM and TO may be either absolute face heights or
3302 `relative' heights; the returned value is always an absolute height
3303 unless both FROM and TO are relative. GCPRO is a lisp value that
3304 will be protected from garbage-collection if this function makes a
3305 call into lisp. */
3307 Lisp_Object
3308 merge_face_heights (from, to, invalid, gcpro)
3309 Lisp_Object from, to, invalid, gcpro;
3311 Lisp_Object result = invalid;
3313 if (INTEGERP (from))
3314 /* FROM is absolute, just use it as is. */
3315 result = from;
3316 else if (FLOATP (from))
3317 /* FROM is a scale, use it to adjust TO. */
3319 if (INTEGERP (to))
3320 /* relative X absolute => absolute */
3321 result = make_number ((EMACS_INT)(XFLOAT_DATA (from) * XINT (to)));
3322 else if (FLOATP (to))
3323 /* relative X relative => relative */
3324 result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
3326 else if (FUNCTIONP (from))
3327 /* FROM is a function, which use to adjust TO. */
3329 /* Call function with current height as argument.
3330 From is the new height. */
3331 Lisp_Object args[2];
3332 struct gcpro gcpro1;
3334 GCPRO1 (gcpro);
3336 args[0] = from;
3337 args[1] = to;
3338 result = safe_call (2, args);
3340 UNGCPRO;
3342 /* Ensure that if TO was absolute, so is the result. */
3343 if (INTEGERP (to) && !INTEGERP (result))
3344 result = invalid;
3347 return result;
3351 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3352 store the resulting attributes in TO, which must be already be
3353 completely specified and contain only absolute attributes. Every
3354 specified attribute of FROM overrides the corresponding attribute of
3355 TO; relative attributes in FROM are merged with the absolute value in
3356 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3357 face inheritance; it should be Qnil when called from other places. */
3359 static INLINE void
3360 merge_face_vectors (f, from, to, cycle_check)
3361 struct frame *f;
3362 Lisp_Object *from, *to;
3363 Lisp_Object cycle_check;
3365 int i;
3367 /* If FROM inherits from some other faces, merge their attributes into
3368 TO before merging FROM's direct attributes. Note that an :inherit
3369 attribute of `unspecified' is the same as one of nil; we never
3370 merge :inherit attributes, so nil is more correct, but lots of
3371 other code uses `unspecified' as a generic value for face attributes. */
3372 if (!UNSPECIFIEDP (from[LFACE_INHERIT_INDEX])
3373 && !NILP (from[LFACE_INHERIT_INDEX]))
3374 merge_face_inheritance (f, from[LFACE_INHERIT_INDEX], to, cycle_check);
3376 /* If TO specifies a :font attribute, and FROM specifies some
3377 font-related attribute, we need to clear TO's :font attribute
3378 (because it will be inconsistent with whatever FROM specifies, and
3379 FROM takes precedence). */
3380 if (!NILP (to[LFACE_FONT_INDEX])
3381 && (!UNSPECIFIEDP (from[LFACE_FAMILY_INDEX])
3382 || !UNSPECIFIEDP (from[LFACE_HEIGHT_INDEX])
3383 || !UNSPECIFIEDP (from[LFACE_WEIGHT_INDEX])
3384 || !UNSPECIFIEDP (from[LFACE_SLANT_INDEX])
3385 || !UNSPECIFIEDP (from[LFACE_SWIDTH_INDEX])
3386 || !UNSPECIFIEDP (from[LFACE_AVGWIDTH_INDEX])))
3387 to[LFACE_FONT_INDEX] = Qnil;
3389 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3390 if (!UNSPECIFIEDP (from[i]))
3392 if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i]))
3393 to[i] = merge_face_heights (from[i], to[i], to[i], cycle_check);
3394 else
3395 to[i] = from[i];
3398 /* TO is always an absolute face, which should inherit from nothing.
3399 We blindly copy the :inherit attribute above and fix it up here. */
3400 to[LFACE_INHERIT_INDEX] = Qnil;
3404 /* Checks the `cycle check' variable CHECK to see if it indicates that
3405 EL is part of a cycle; CHECK must be either Qnil or a value returned
3406 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3407 elements after which a cycle might be suspected; after that many
3408 elements, this macro begins consing in order to keep more precise
3409 track of elements.
3411 Returns nil if a cycle was detected, otherwise a new value for CHECK
3412 that includes EL.
3414 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3415 the caller should make sure that's ok. */
3417 #define CYCLE_CHECK(check, el, suspicious) \
3418 (NILP (check) \
3419 ? make_number (0) \
3420 : (INTEGERP (check) \
3421 ? (XFASTINT (check) < (suspicious) \
3422 ? make_number (XFASTINT (check) + 1) \
3423 : Fcons (el, Qnil)) \
3424 : (!NILP (Fmemq ((el), (check))) \
3425 ? Qnil \
3426 : Fcons ((el), (check)))))
3429 /* Merge face attributes from the face on frame F whose name is
3430 INHERITS, into the vector of face attributes TO; INHERITS may also be
3431 a list of face names, in which case they are applied in order.
3432 CYCLE_CHECK is used to detect loops in face inheritance.
3433 Returns true if any of the inherited attributes are `font-related'. */
3435 static void
3436 merge_face_inheritance (f, inherit, to, cycle_check)
3437 struct frame *f;
3438 Lisp_Object inherit;
3439 Lisp_Object *to;
3440 Lisp_Object cycle_check;
3442 if (SYMBOLP (inherit) && !EQ (inherit, Qunspecified))
3443 /* Inherit from the named face INHERIT. */
3445 Lisp_Object lface;
3447 /* Make sure we're not in an inheritance loop. */
3448 cycle_check = CYCLE_CHECK (cycle_check, inherit, 15);
3449 if (NILP (cycle_check))
3450 /* Cycle detected, ignore any further inheritance. */
3451 return;
3453 lface = lface_from_face_name (f, inherit, 0);
3454 if (!NILP (lface))
3455 merge_face_vectors (f, XVECTOR (lface)->contents, to, cycle_check);
3457 else if (CONSP (inherit))
3458 /* Handle a list of inherited faces by calling ourselves recursively
3459 on each element. Note that we only do so for symbol elements, so
3460 it's not possible to infinitely recurse. */
3462 while (CONSP (inherit))
3464 if (SYMBOLP (XCAR (inherit)))
3465 merge_face_inheritance (f, XCAR (inherit), to, cycle_check);
3467 /* Check for a circular inheritance list. */
3468 cycle_check = CYCLE_CHECK (cycle_check, inherit, 15);
3469 if (NILP (cycle_check))
3470 /* Cycle detected. */
3471 break;
3473 inherit = XCDR (inherit);
3479 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3480 is a face property, determine the resulting face attributes on
3481 frame F, and store them in TO. PROP may be a single face
3482 specification or a list of such specifications. Each face
3483 specification can be
3485 1. A symbol or string naming a Lisp face.
3487 2. A property list of the form (KEYWORD VALUE ...) where each
3488 KEYWORD is a face attribute name, and value is an appropriate value
3489 for that attribute.
3491 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3492 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3493 for compatibility with 20.2.
3495 Face specifications earlier in lists take precedence over later
3496 specifications. */
3498 static void
3499 merge_face_vector_with_property (f, to, prop)
3500 struct frame *f;
3501 Lisp_Object *to;
3502 Lisp_Object prop;
3504 if (CONSP (prop))
3506 Lisp_Object first = XCAR (prop);
3508 if (EQ (first, Qforeground_color)
3509 || EQ (first, Qbackground_color))
3511 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3512 . COLOR). COLOR must be a string. */
3513 Lisp_Object color_name = XCDR (prop);
3514 Lisp_Object color = first;
3516 if (STRINGP (color_name))
3518 if (EQ (color, Qforeground_color))
3519 to[LFACE_FOREGROUND_INDEX] = color_name;
3520 else
3521 to[LFACE_BACKGROUND_INDEX] = color_name;
3523 else
3524 add_to_log ("Invalid face color", color_name, Qnil);
3526 else if (SYMBOLP (first)
3527 && *SDATA (SYMBOL_NAME (first)) == ':')
3529 /* Assume this is the property list form. */
3530 while (CONSP (prop) && CONSP (XCDR (prop)))
3532 Lisp_Object keyword = XCAR (prop);
3533 Lisp_Object value = XCAR (XCDR (prop));
3535 if (EQ (keyword, QCfamily))
3537 if (STRINGP (value))
3538 to[LFACE_FAMILY_INDEX] = value;
3539 else
3540 add_to_log ("Invalid face font family", value, Qnil);
3542 else if (EQ (keyword, QCheight))
3544 Lisp_Object new_height =
3545 merge_face_heights (value, to[LFACE_HEIGHT_INDEX],
3546 Qnil, Qnil);
3548 if (NILP (new_height))
3549 add_to_log ("Invalid face font height", value, Qnil);
3550 else
3551 to[LFACE_HEIGHT_INDEX] = new_height;
3553 else if (EQ (keyword, QCweight))
3555 if (SYMBOLP (value)
3556 && face_numeric_weight (value) >= 0)
3557 to[LFACE_WEIGHT_INDEX] = value;
3558 else
3559 add_to_log ("Invalid face weight", value, Qnil);
3561 else if (EQ (keyword, QCslant))
3563 if (SYMBOLP (value)
3564 && face_numeric_slant (value) >= 0)
3565 to[LFACE_SLANT_INDEX] = value;
3566 else
3567 add_to_log ("Invalid face slant", value, Qnil);
3569 else if (EQ (keyword, QCunderline))
3571 if (EQ (value, Qt)
3572 || NILP (value)
3573 || STRINGP (value))
3574 to[LFACE_UNDERLINE_INDEX] = value;
3575 else
3576 add_to_log ("Invalid face underline", value, Qnil);
3578 else if (EQ (keyword, QCoverline))
3580 if (EQ (value, Qt)
3581 || NILP (value)
3582 || STRINGP (value))
3583 to[LFACE_OVERLINE_INDEX] = value;
3584 else
3585 add_to_log ("Invalid face overline", value, Qnil);
3587 else if (EQ (keyword, QCstrike_through))
3589 if (EQ (value, Qt)
3590 || NILP (value)
3591 || STRINGP (value))
3592 to[LFACE_STRIKE_THROUGH_INDEX] = value;
3593 else
3594 add_to_log ("Invalid face strike-through", value, Qnil);
3596 else if (EQ (keyword, QCbox))
3598 if (EQ (value, Qt))
3599 value = make_number (1);
3600 if (INTEGERP (value)
3601 || STRINGP (value)
3602 || CONSP (value)
3603 || NILP (value))
3604 to[LFACE_BOX_INDEX] = value;
3605 else
3606 add_to_log ("Invalid face box", value, Qnil);
3608 else if (EQ (keyword, QCinverse_video)
3609 || EQ (keyword, QCreverse_video))
3611 if (EQ (value, Qt) || NILP (value))
3612 to[LFACE_INVERSE_INDEX] = value;
3613 else
3614 add_to_log ("Invalid face inverse-video", value, Qnil);
3616 else if (EQ (keyword, QCforeground))
3618 if (STRINGP (value))
3619 to[LFACE_FOREGROUND_INDEX] = value;
3620 else
3621 add_to_log ("Invalid face foreground", value, Qnil);
3623 else if (EQ (keyword, QCbackground))
3625 if (STRINGP (value))
3626 to[LFACE_BACKGROUND_INDEX] = value;
3627 else
3628 add_to_log ("Invalid face background", value, Qnil);
3630 else if (EQ (keyword, QCstipple))
3632 #ifdef HAVE_X_WINDOWS
3633 Lisp_Object pixmap_p = Fbitmap_spec_p (value);
3634 if (!NILP (pixmap_p))
3635 to[LFACE_STIPPLE_INDEX] = value;
3636 else
3637 add_to_log ("Invalid face stipple", value, Qnil);
3638 #endif
3640 else if (EQ (keyword, QCwidth))
3642 if (SYMBOLP (value)
3643 && face_numeric_swidth (value) >= 0)
3644 to[LFACE_SWIDTH_INDEX] = value;
3645 else
3646 add_to_log ("Invalid face width", value, Qnil);
3648 else if (EQ (keyword, QCinherit))
3650 if (SYMBOLP (value))
3651 to[LFACE_INHERIT_INDEX] = value;
3652 else
3654 Lisp_Object tail;
3655 for (tail = value; CONSP (tail); tail = XCDR (tail))
3656 if (!SYMBOLP (XCAR (tail)))
3657 break;
3658 if (NILP (tail))
3659 to[LFACE_INHERIT_INDEX] = value;
3660 else
3661 add_to_log ("Invalid face inherit", value, Qnil);
3664 else
3665 add_to_log ("Invalid attribute %s in face property",
3666 keyword, Qnil);
3668 prop = XCDR (XCDR (prop));
3671 else
3673 /* This is a list of face specs. Specifications at the
3674 beginning of the list take precedence over later
3675 specifications, so we have to merge starting with the
3676 last specification. */
3677 Lisp_Object next = XCDR (prop);
3678 if (!NILP (next))
3679 merge_face_vector_with_property (f, to, next);
3680 merge_face_vector_with_property (f, to, first);
3683 else
3685 /* PROP ought to be a face name. */
3686 Lisp_Object lface = lface_from_face_name (f, prop, 0);
3687 if (NILP (lface))
3688 add_to_log ("Invalid face text property value: %s", prop, Qnil);
3689 else
3690 merge_face_vectors (f, XVECTOR (lface)->contents, to, Qnil);
3695 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
3696 Sinternal_make_lisp_face, 1, 2, 0,
3697 doc: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3698 If FACE was not known as a face before, create a new one.
3699 If optional argument FRAME is specified, make a frame-local face
3700 for that frame. Otherwise operate on the global face definition.
3701 Value is a vector of face attributes. */)
3702 (face, frame)
3703 Lisp_Object face, frame;
3705 Lisp_Object global_lface, lface;
3706 struct frame *f;
3707 int i;
3709 CHECK_SYMBOL (face);
3710 global_lface = lface_from_face_name (NULL, face, 0);
3712 if (!NILP (frame))
3714 CHECK_LIVE_FRAME (frame);
3715 f = XFRAME (frame);
3716 lface = lface_from_face_name (f, face, 0);
3718 else
3719 f = NULL, lface = Qnil;
3721 /* Add a global definition if there is none. */
3722 if (NILP (global_lface))
3724 global_lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
3725 Qunspecified);
3726 AREF (global_lface, 0) = Qface;
3727 Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
3728 Vface_new_frame_defaults);
3730 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3731 face id to Lisp face is given by the vector lface_id_to_name.
3732 The mapping from Lisp face to Lisp face id is given by the
3733 property `face' of the Lisp face name. */
3734 if (next_lface_id == lface_id_to_name_size)
3736 int new_size = max (50, 2 * lface_id_to_name_size);
3737 int sz = new_size * sizeof *lface_id_to_name;
3738 lface_id_to_name = (Lisp_Object *) xrealloc (lface_id_to_name, sz);
3739 lface_id_to_name_size = new_size;
3742 lface_id_to_name[next_lface_id] = face;
3743 Fput (face, Qface, make_number (next_lface_id));
3744 ++next_lface_id;
3746 else if (f == NULL)
3747 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3748 AREF (global_lface, i) = Qunspecified;
3750 /* Add a frame-local definition. */
3751 if (f)
3753 if (NILP (lface))
3755 lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
3756 Qunspecified);
3757 AREF (lface, 0) = Qface;
3758 f->face_alist = Fcons (Fcons (face, lface), f->face_alist);
3760 else
3761 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
3762 AREF (lface, i) = Qunspecified;
3764 else
3765 lface = global_lface;
3767 /* Changing a named face means that all realized faces depending on
3768 that face are invalid. Since we cannot tell which realized faces
3769 depend on the face, make sure they are all removed. This is done
3770 by incrementing face_change_count. The next call to
3771 init_iterator will then free realized faces. */
3772 ++face_change_count;
3773 ++windows_or_buffers_changed;
3775 xassert (LFACEP (lface));
3776 check_lface (lface);
3777 return lface;
3781 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p,
3782 Sinternal_lisp_face_p, 1, 2, 0,
3783 doc: /* Return non-nil if FACE names a face.
3784 If optional second parameter FRAME is non-nil, check for the
3785 existence of a frame-local face with name FACE on that frame.
3786 Otherwise check for the existence of a global face. */)
3787 (face, frame)
3788 Lisp_Object face, frame;
3790 Lisp_Object lface;
3792 if (!NILP (frame))
3794 CHECK_LIVE_FRAME (frame);
3795 lface = lface_from_face_name (XFRAME (frame), face, 0);
3797 else
3798 lface = lface_from_face_name (NULL, face, 0);
3800 return lface;
3804 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face,
3805 Sinternal_copy_lisp_face, 4, 4, 0,
3806 doc: /* Copy face FROM to TO.
3807 If FRAME it t, copy the global face definition of FROM to the
3808 global face definition of TO. Otherwise, copy the frame-local
3809 definition of FROM on FRAME to the frame-local definition of TO
3810 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3812 Value is TO. */)
3813 (from, to, frame, new_frame)
3814 Lisp_Object from, to, frame, new_frame;
3816 Lisp_Object lface, copy;
3818 CHECK_SYMBOL (from);
3819 CHECK_SYMBOL (to);
3820 if (NILP (new_frame))
3821 new_frame = frame;
3823 if (EQ (frame, Qt))
3825 /* Copy global definition of FROM. We don't make copies of
3826 strings etc. because 20.2 didn't do it either. */
3827 lface = lface_from_face_name (NULL, from, 1);
3828 copy = Finternal_make_lisp_face (to, Qnil);
3830 else
3832 /* Copy frame-local definition of FROM. */
3833 CHECK_LIVE_FRAME (frame);
3834 CHECK_LIVE_FRAME (new_frame);
3835 lface = lface_from_face_name (XFRAME (frame), from, 1);
3836 copy = Finternal_make_lisp_face (to, new_frame);
3839 bcopy (XVECTOR (lface)->contents, XVECTOR (copy)->contents,
3840 LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
3842 /* Changing a named face means that all realized faces depending on
3843 that face are invalid. Since we cannot tell which realized faces
3844 depend on the face, make sure they are all removed. This is done
3845 by incrementing face_change_count. The next call to
3846 init_iterator will then free realized faces. */
3847 ++face_change_count;
3848 ++windows_or_buffers_changed;
3850 return to;
3854 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
3855 Sinternal_set_lisp_face_attribute, 3, 4, 0,
3856 doc: /* Set attribute ATTR of FACE to VALUE.
3857 FRAME being a frame means change the face on that frame.
3858 FRAME nil means change the face of the selected frame.
3859 FRAME t means change the default for new frames.
3860 FRAME 0 means change the face on all frames, and change the default
3861 for new frames. */)
3862 (face, attr, value, frame)
3863 Lisp_Object face, attr, value, frame;
3865 Lisp_Object lface;
3866 Lisp_Object old_value = Qnil;
3867 /* Set 1 if ATTR is QCfont. */
3868 int font_attr_p = 0;
3869 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3870 int font_related_attr_p = 0;
3872 CHECK_SYMBOL (face);
3873 CHECK_SYMBOL (attr);
3875 face = resolve_face_name (face);
3877 /* If FRAME is 0, change face on all frames, and change the
3878 default for new frames. */
3879 if (INTEGERP (frame) && XINT (frame) == 0)
3881 Lisp_Object tail;
3882 Finternal_set_lisp_face_attribute (face, attr, value, Qt);
3883 FOR_EACH_FRAME (tail, frame)
3884 Finternal_set_lisp_face_attribute (face, attr, value, frame);
3885 return face;
3888 /* Set lface to the Lisp attribute vector of FACE. */
3889 if (EQ (frame, Qt))
3890 lface = lface_from_face_name (NULL, face, 1);
3891 else
3893 if (NILP (frame))
3894 frame = selected_frame;
3896 CHECK_LIVE_FRAME (frame);
3897 lface = lface_from_face_name (XFRAME (frame), face, 0);
3899 /* If a frame-local face doesn't exist yet, create one. */
3900 if (NILP (lface))
3901 lface = Finternal_make_lisp_face (face, frame);
3904 if (EQ (attr, QCfamily))
3906 if (!UNSPECIFIEDP (value))
3908 CHECK_STRING (value);
3909 if (SCHARS (value) == 0)
3910 signal_error ("Invalid face family", value);
3912 old_value = LFACE_FAMILY (lface);
3913 LFACE_FAMILY (lface) = value;
3914 font_related_attr_p = 1;
3916 else if (EQ (attr, QCheight))
3918 if (!UNSPECIFIEDP (value))
3920 Lisp_Object test;
3922 test = (EQ (face, Qdefault)
3923 ? value
3924 /* The default face must have an absolute size,
3925 otherwise, we do a test merge with a random
3926 height to see if VALUE's ok. */
3927 : merge_face_heights (value, make_number (10), Qnil, Qnil));
3929 if (!INTEGERP (test) || XINT (test) <= 0)
3930 signal_error ("Invalid face height", value);
3933 old_value = LFACE_HEIGHT (lface);
3934 LFACE_HEIGHT (lface) = value;
3935 font_related_attr_p = 1;
3937 else if (EQ (attr, QCweight))
3939 if (!UNSPECIFIEDP (value))
3941 CHECK_SYMBOL (value);
3942 if (face_numeric_weight (value) < 0)
3943 signal_error ("Invalid face weight", value);
3945 old_value = LFACE_WEIGHT (lface);
3946 LFACE_WEIGHT (lface) = value;
3947 font_related_attr_p = 1;
3949 else if (EQ (attr, QCslant))
3951 if (!UNSPECIFIEDP (value))
3953 CHECK_SYMBOL (value);
3954 if (face_numeric_slant (value) < 0)
3955 signal_error ("Invalid face slant", value);
3957 old_value = LFACE_SLANT (lface);
3958 LFACE_SLANT (lface) = value;
3959 font_related_attr_p = 1;
3961 else if (EQ (attr, QCunderline))
3963 if (!UNSPECIFIEDP (value))
3964 if ((SYMBOLP (value)
3965 && !EQ (value, Qt)
3966 && !EQ (value, Qnil))
3967 /* Underline color. */
3968 || (STRINGP (value)
3969 && SCHARS (value) == 0))
3970 signal_error ("Invalid face underline", value);
3972 old_value = LFACE_UNDERLINE (lface);
3973 LFACE_UNDERLINE (lface) = value;
3975 else if (EQ (attr, QCoverline))
3977 if (!UNSPECIFIEDP (value))
3978 if ((SYMBOLP (value)
3979 && !EQ (value, Qt)
3980 && !EQ (value, Qnil))
3981 /* Overline color. */
3982 || (STRINGP (value)
3983 && SCHARS (value) == 0))
3984 signal_error ("Invalid face overline", value);
3986 old_value = LFACE_OVERLINE (lface);
3987 LFACE_OVERLINE (lface) = value;
3989 else if (EQ (attr, QCstrike_through))
3991 if (!UNSPECIFIEDP (value))
3992 if ((SYMBOLP (value)
3993 && !EQ (value, Qt)
3994 && !EQ (value, Qnil))
3995 /* Strike-through color. */
3996 || (STRINGP (value)
3997 && SCHARS (value) == 0))
3998 signal_error ("Invalid face strike-through", value);
4000 old_value = LFACE_STRIKE_THROUGH (lface);
4001 LFACE_STRIKE_THROUGH (lface) = value;
4003 else if (EQ (attr, QCbox))
4005 int valid_p;
4007 /* Allow t meaning a simple box of width 1 in foreground color
4008 of the face. */
4009 if (EQ (value, Qt))
4010 value = make_number (1);
4012 if (UNSPECIFIEDP (value))
4013 valid_p = 1;
4014 else if (NILP (value))
4015 valid_p = 1;
4016 else if (INTEGERP (value))
4017 valid_p = XINT (value) != 0;
4018 else if (STRINGP (value))
4019 valid_p = SCHARS (value) > 0;
4020 else if (CONSP (value))
4022 Lisp_Object tem;
4024 tem = value;
4025 while (CONSP (tem))
4027 Lisp_Object k, v;
4029 k = XCAR (tem);
4030 tem = XCDR (tem);
4031 if (!CONSP (tem))
4032 break;
4033 v = XCAR (tem);
4034 tem = XCDR (tem);
4036 if (EQ (k, QCline_width))
4038 if (!INTEGERP (v) || XINT (v) == 0)
4039 break;
4041 else if (EQ (k, QCcolor))
4043 if (!STRINGP (v) || SCHARS (v) == 0)
4044 break;
4046 else if (EQ (k, QCstyle))
4048 if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button))
4049 break;
4051 else
4052 break;
4055 valid_p = NILP (tem);
4057 else
4058 valid_p = 0;
4060 if (!valid_p)
4061 signal_error ("Invalid face box", value);
4063 old_value = LFACE_BOX (lface);
4064 LFACE_BOX (lface) = value;
4066 else if (EQ (attr, QCinverse_video)
4067 || EQ (attr, QCreverse_video))
4069 if (!UNSPECIFIEDP (value))
4071 CHECK_SYMBOL (value);
4072 if (!EQ (value, Qt) && !NILP (value))
4073 signal_error ("Invalid inverse-video face attribute value", value);
4075 old_value = LFACE_INVERSE (lface);
4076 LFACE_INVERSE (lface) = value;
4078 else if (EQ (attr, QCforeground))
4080 if (!UNSPECIFIEDP (value))
4082 /* Don't check for valid color names here because it depends
4083 on the frame (display) whether the color will be valid
4084 when the face is realized. */
4085 CHECK_STRING (value);
4086 if (SCHARS (value) == 0)
4087 signal_error ("Empty foreground color value", value);
4089 old_value = LFACE_FOREGROUND (lface);
4090 LFACE_FOREGROUND (lface) = value;
4092 else if (EQ (attr, QCbackground))
4094 if (!UNSPECIFIEDP (value))
4096 /* Don't check for valid color names here because it depends
4097 on the frame (display) whether the color will be valid
4098 when the face is realized. */
4099 CHECK_STRING (value);
4100 if (SCHARS (value) == 0)
4101 signal_error ("Empty background color value", value);
4103 old_value = LFACE_BACKGROUND (lface);
4104 LFACE_BACKGROUND (lface) = value;
4106 else if (EQ (attr, QCstipple))
4108 #ifdef HAVE_X_WINDOWS
4109 if (!UNSPECIFIEDP (value)
4110 && !NILP (value)
4111 && NILP (Fbitmap_spec_p (value)))
4112 signal_error ("Invalid stipple attribute", value);
4113 old_value = LFACE_STIPPLE (lface);
4114 LFACE_STIPPLE (lface) = value;
4115 #endif /* HAVE_X_WINDOWS */
4117 else if (EQ (attr, QCwidth))
4119 if (!UNSPECIFIEDP (value))
4121 CHECK_SYMBOL (value);
4122 if (face_numeric_swidth (value) < 0)
4123 signal_error ("Invalid face width", value);
4125 old_value = LFACE_SWIDTH (lface);
4126 LFACE_SWIDTH (lface) = value;
4127 font_related_attr_p = 1;
4129 else if (EQ (attr, QCfont))
4131 #ifdef HAVE_WINDOW_SYSTEM
4132 if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame)))
4134 /* Set font-related attributes of the Lisp face from an XLFD
4135 font name. */
4136 struct frame *f;
4137 Lisp_Object tmp;
4139 if (EQ (frame, Qt))
4140 f = SELECTED_FRAME ();
4141 else
4142 f = check_x_frame (frame);
4144 if (!UNSPECIFIEDP (value))
4146 CHECK_STRING (value);
4148 /* VALUE may be a fontset name or an alias of fontset. In
4149 such a case, use the base fontset name. */
4150 tmp = Fquery_fontset (value, Qnil);
4151 if (!NILP (tmp))
4152 value = tmp;
4154 if (!set_lface_from_font_name (f, lface, value, 1, 1))
4155 signal_error ("Invalid font or fontset name", value);
4158 font_attr_p = 1;
4160 #endif /* HAVE_WINDOW_SYSTEM */
4162 else if (EQ (attr, QCinherit))
4164 Lisp_Object tail;
4165 if (SYMBOLP (value))
4166 tail = Qnil;
4167 else
4168 for (tail = value; CONSP (tail); tail = XCDR (tail))
4169 if (!SYMBOLP (XCAR (tail)))
4170 break;
4171 if (NILP (tail))
4172 LFACE_INHERIT (lface) = value;
4173 else
4174 signal_error ("Invalid face inheritance", value);
4176 else if (EQ (attr, QCbold))
4178 old_value = LFACE_WEIGHT (lface);
4179 LFACE_WEIGHT (lface) = NILP (value) ? Qnormal : Qbold;
4180 font_related_attr_p = 1;
4182 else if (EQ (attr, QCitalic))
4184 old_value = LFACE_SLANT (lface);
4185 LFACE_SLANT (lface) = NILP (value) ? Qnormal : Qitalic;
4186 font_related_attr_p = 1;
4188 else
4189 signal_error ("Invalid face attribute name", attr);
4191 if (font_related_attr_p
4192 && !UNSPECIFIEDP (value))
4193 /* If a font-related attribute other than QCfont is specified, the
4194 original `font' attribute nor that of default face is useless
4195 to determine a new font. Thus, we set it to nil so that font
4196 selection mechanism doesn't use it. */
4197 LFACE_FONT (lface) = Qnil;
4199 /* Changing a named face means that all realized faces depending on
4200 that face are invalid. Since we cannot tell which realized faces
4201 depend on the face, make sure they are all removed. This is done
4202 by incrementing face_change_count. The next call to
4203 init_iterator will then free realized faces. */
4204 if (!EQ (frame, Qt)
4205 && (EQ (attr, QCfont)
4206 || NILP (Fequal (old_value, value))))
4208 ++face_change_count;
4209 ++windows_or_buffers_changed;
4212 if (!UNSPECIFIEDP (value)
4213 && NILP (Fequal (old_value, value)))
4215 Lisp_Object param;
4217 param = Qnil;
4219 if (EQ (face, Qdefault))
4221 #ifdef HAVE_WINDOW_SYSTEM
4222 /* Changed font-related attributes of the `default' face are
4223 reflected in changed `font' frame parameters. */
4224 if (FRAMEP (frame)
4225 && (font_related_attr_p || font_attr_p)
4226 && lface_fully_specified_p (XVECTOR (lface)->contents))
4227 set_font_frame_param (frame, lface);
4228 else
4229 #endif /* HAVE_WINDOW_SYSTEM */
4231 if (EQ (attr, QCforeground))
4232 param = Qforeground_color;
4233 else if (EQ (attr, QCbackground))
4234 param = Qbackground_color;
4236 #ifdef HAVE_WINDOW_SYSTEM
4237 #ifndef WINDOWSNT
4238 else if (EQ (face, Qscroll_bar))
4240 /* Changing the colors of `scroll-bar' sets frame parameters
4241 `scroll-bar-foreground' and `scroll-bar-background'. */
4242 if (EQ (attr, QCforeground))
4243 param = Qscroll_bar_foreground;
4244 else if (EQ (attr, QCbackground))
4245 param = Qscroll_bar_background;
4247 #endif /* not WINDOWSNT */
4248 else if (EQ (face, Qborder))
4250 /* Changing background color of `border' sets frame parameter
4251 `border-color'. */
4252 if (EQ (attr, QCbackground))
4253 param = Qborder_color;
4255 else if (EQ (face, Qcursor))
4257 /* Changing background color of `cursor' sets frame parameter
4258 `cursor-color'. */
4259 if (EQ (attr, QCbackground))
4260 param = Qcursor_color;
4262 else if (EQ (face, Qmouse))
4264 /* Changing background color of `mouse' sets frame parameter
4265 `mouse-color'. */
4266 if (EQ (attr, QCbackground))
4267 param = Qmouse_color;
4269 #endif /* HAVE_WINDOW_SYSTEM */
4270 else if (EQ (face, Qmenu))
4272 /* Indicate that we have to update the menu bar when
4273 realizing faces on FRAME. FRAME t change the
4274 default for new frames. We do this by setting
4275 setting the flag in new face caches */
4276 if (FRAMEP (frame))
4278 struct frame *f = XFRAME (frame);
4279 if (FRAME_FACE_CACHE (f) == NULL)
4280 FRAME_FACE_CACHE (f) = make_face_cache (f);
4281 FRAME_FACE_CACHE (f)->menu_face_changed_p = 1;
4283 else
4284 menu_face_changed_default = 1;
4287 if (!NILP (param))
4289 if (EQ (frame, Qt))
4290 /* Update `default-frame-alist', which is used for new frames. */
4292 store_in_alist (&Vdefault_frame_alist, param, value);
4294 else
4295 /* Update the current frame's parameters. */
4297 Lisp_Object cons;
4298 cons = XCAR (Vparam_value_alist);
4299 XSETCAR (cons, param);
4300 XSETCDR (cons, value);
4301 Fmodify_frame_parameters (frame, Vparam_value_alist);
4306 return face;
4310 #ifdef HAVE_WINDOW_SYSTEM
4312 /* Set the `font' frame parameter of FRAME determined from `default'
4313 face attributes LFACE. If a face or fontset name is explicitely
4314 specfied in LFACE, use it as is. Otherwise, determine a font name
4315 from the other font-related atrributes of LFACE. In that case, if
4316 there's no matching font, signals an error. */
4318 static void
4319 set_font_frame_param (frame, lface)
4320 Lisp_Object frame, lface;
4322 struct frame *f = XFRAME (frame);
4324 if (FRAME_WINDOW_P (f))
4326 Lisp_Object font_name;
4327 char *font;
4329 if (STRINGP (LFACE_FONT (lface)))
4330 font_name = LFACE_FONT (lface);
4331 else
4333 /* Choose a font name that reflects LFACE's attributes and has
4334 the registry and encoding pattern specified in the default
4335 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4336 font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0, 0);
4337 if (!font)
4338 error ("No font matches the specified attribute");
4339 font_name = build_string (font);
4340 xfree (font);
4343 f->default_face_done_p = 0;
4344 Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font_name), Qnil));
4349 /* Update the corresponding face when frame parameter PARAM on frame F
4350 has been assigned the value NEW_VALUE. */
4352 void
4353 update_face_from_frame_parameter (f, param, new_value)
4354 struct frame *f;
4355 Lisp_Object param, new_value;
4357 Lisp_Object lface;
4359 /* If there are no faces yet, give up. This is the case when called
4360 from Fx_create_frame, and we do the necessary things later in
4361 face-set-after-frame-defaults. */
4362 if (NILP (f->face_alist))
4363 return;
4365 /* Changing a named face means that all realized faces depending on
4366 that face are invalid. Since we cannot tell which realized faces
4367 depend on the face, make sure they are all removed. This is done
4368 by incrementing face_change_count. The next call to
4369 init_iterator will then free realized faces. */
4370 ++face_change_count;
4371 ++windows_or_buffers_changed;
4373 if (EQ (param, Qforeground_color))
4375 lface = lface_from_face_name (f, Qdefault, 1);
4376 LFACE_FOREGROUND (lface) = (STRINGP (new_value)
4377 ? new_value : Qunspecified);
4378 realize_basic_faces (f);
4380 else if (EQ (param, Qbackground_color))
4382 Lisp_Object frame;
4384 /* Changing the background color might change the background
4385 mode, so that we have to load new defface specs. Call
4386 frame-update-face-colors to do that. */
4387 XSETFRAME (frame, f);
4388 call1 (Qframe_update_face_colors, frame);
4390 lface = lface_from_face_name (f, Qdefault, 1);
4391 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4392 ? new_value : Qunspecified);
4393 realize_basic_faces (f);
4395 if (EQ (param, Qborder_color))
4397 lface = lface_from_face_name (f, Qborder, 1);
4398 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4399 ? new_value : Qunspecified);
4401 else if (EQ (param, Qcursor_color))
4403 lface = lface_from_face_name (f, Qcursor, 1);
4404 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4405 ? new_value : Qunspecified);
4407 else if (EQ (param, Qmouse_color))
4409 lface = lface_from_face_name (f, Qmouse, 1);
4410 LFACE_BACKGROUND (lface) = (STRINGP (new_value)
4411 ? new_value : Qunspecified);
4416 /* Get the value of X resource RESOURCE, class CLASS for the display
4417 of frame FRAME. This is here because ordinary `x-get-resource'
4418 doesn't take a frame argument. */
4420 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
4421 Sinternal_face_x_get_resource, 3, 3, 0, doc: /* */)
4422 (resource, class, frame)
4423 Lisp_Object resource, class, frame;
4425 Lisp_Object value = Qnil;
4426 CHECK_STRING (resource);
4427 CHECK_STRING (class);
4428 CHECK_LIVE_FRAME (frame);
4429 BLOCK_INPUT;
4430 value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
4431 resource, class, Qnil, Qnil);
4432 UNBLOCK_INPUT;
4433 return value;
4437 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4438 If VALUE is "on" or "true", return t. If VALUE is "off" or
4439 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4440 error; if SIGNAL_P is zero, return 0. */
4442 static Lisp_Object
4443 face_boolean_x_resource_value (value, signal_p)
4444 Lisp_Object value;
4445 int signal_p;
4447 Lisp_Object result = make_number (0);
4449 xassert (STRINGP (value));
4451 if (xstricmp (SDATA (value), "on") == 0
4452 || xstricmp (SDATA (value), "true") == 0)
4453 result = Qt;
4454 else if (xstricmp (SDATA (value), "off") == 0
4455 || xstricmp (SDATA (value), "false") == 0)
4456 result = Qnil;
4457 else if (xstricmp (SDATA (value), "unspecified") == 0)
4458 result = Qunspecified;
4459 else if (signal_p)
4460 signal_error ("Invalid face attribute value from X resource", value);
4462 return result;
4466 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4467 Finternal_set_lisp_face_attribute_from_resource,
4468 Sinternal_set_lisp_face_attribute_from_resource,
4469 3, 4, 0, doc: /* */)
4470 (face, attr, value, frame)
4471 Lisp_Object face, attr, value, frame;
4473 CHECK_SYMBOL (face);
4474 CHECK_SYMBOL (attr);
4475 CHECK_STRING (value);
4477 if (xstricmp (SDATA (value), "unspecified") == 0)
4478 value = Qunspecified;
4479 else if (EQ (attr, QCheight))
4481 value = Fstring_to_number (value, make_number (10));
4482 if (XINT (value) <= 0)
4483 signal_error ("Invalid face height from X resource", value);
4485 else if (EQ (attr, QCbold) || EQ (attr, QCitalic))
4486 value = face_boolean_x_resource_value (value, 1);
4487 else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth))
4488 value = intern (SDATA (value));
4489 else if (EQ (attr, QCreverse_video) || EQ (attr, QCinverse_video))
4490 value = face_boolean_x_resource_value (value, 1);
4491 else if (EQ (attr, QCunderline)
4492 || EQ (attr, QCoverline)
4493 || EQ (attr, QCstrike_through))
4495 Lisp_Object boolean_value;
4497 /* If the result of face_boolean_x_resource_value is t or nil,
4498 VALUE does NOT specify a color. */
4499 boolean_value = face_boolean_x_resource_value (value, 0);
4500 if (SYMBOLP (boolean_value))
4501 value = boolean_value;
4503 else if (EQ (attr, QCbox))
4504 value = Fcar (Fread_from_string (value, Qnil, Qnil));
4506 return Finternal_set_lisp_face_attribute (face, attr, value, frame);
4509 #endif /* HAVE_WINDOW_SYSTEM */
4512 /***********************************************************************
4513 Menu face
4514 ***********************************************************************/
4516 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4518 /* Make menus on frame F appear as specified by the `menu' face. */
4520 static void
4521 x_update_menu_appearance (f)
4522 struct frame *f;
4524 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4525 XrmDatabase rdb;
4527 if (dpyinfo
4528 && (rdb = XrmGetDatabase (FRAME_X_DISPLAY (f)),
4529 rdb != NULL))
4531 char line[512];
4532 Lisp_Object lface = lface_from_face_name (f, Qmenu, 1);
4533 struct face *face = FACE_FROM_ID (f, MENU_FACE_ID);
4534 const char *myname = SDATA (Vx_resource_name);
4535 int changed_p = 0;
4536 #ifdef USE_MOTIF
4537 const char *popup_path = "popup_menu";
4538 #else
4539 const char *popup_path = "menu.popup";
4540 #endif
4542 if (STRINGP (LFACE_FOREGROUND (lface)))
4544 sprintf (line, "%s.%s*foreground: %s",
4545 myname, popup_path,
4546 SDATA (LFACE_FOREGROUND (lface)));
4547 XrmPutLineResource (&rdb, line);
4548 sprintf (line, "%s.pane.menubar*foreground: %s",
4549 myname, SDATA (LFACE_FOREGROUND (lface)));
4550 XrmPutLineResource (&rdb, line);
4551 changed_p = 1;
4554 if (STRINGP (LFACE_BACKGROUND (lface)))
4556 sprintf (line, "%s.%s*background: %s",
4557 myname, popup_path,
4558 SDATA (LFACE_BACKGROUND (lface)));
4559 XrmPutLineResource (&rdb, line);
4560 sprintf (line, "%s.pane.menubar*background: %s",
4561 myname, SDATA (LFACE_BACKGROUND (lface)));
4562 XrmPutLineResource (&rdb, line);
4563 changed_p = 1;
4566 if (face->font_name
4567 && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
4568 || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
4569 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface))
4570 || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
4571 || !UNSPECIFIEDP (LFACE_SLANT (lface))
4572 || !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
4574 #ifdef USE_MOTIF
4575 const char *suffix = "List";
4576 #else
4577 const char *suffix = "";
4578 #endif
4579 sprintf (line, "%s.pane.menubar*font%s: %s",
4580 myname, suffix, face->font_name);
4581 XrmPutLineResource (&rdb, line);
4582 sprintf (line, "%s.%s*font%s: %s",
4583 myname, popup_path, suffix, face->font_name);
4584 XrmPutLineResource (&rdb, line);
4585 changed_p = 1;
4588 if (changed_p && f->output_data.x->menubar_widget)
4589 free_frame_menubar (f);
4593 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4596 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
4597 Sface_attribute_relative_p,
4598 2, 2, 0,
4599 doc: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4600 (attribute, value)
4601 Lisp_Object attribute, value;
4603 if (EQ (value, Qunspecified))
4604 return Qt;
4605 else if (EQ (attribute, QCheight))
4606 return INTEGERP (value) ? Qnil : Qt;
4607 else
4608 return Qnil;
4611 DEFUN ("merge-face-attribute", Fmerge_face_attribute, Smerge_face_attribute,
4612 3, 3, 0,
4613 doc: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4614 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4615 the result will be absolute, otherwise it will be relative. */)
4616 (attribute, value1, value2)
4617 Lisp_Object attribute, value1, value2;
4619 if (EQ (value1, Qunspecified))
4620 return value2;
4621 else if (EQ (attribute, QCheight))
4622 return merge_face_heights (value1, value2, value1, Qnil);
4623 else
4624 return value1;
4628 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute,
4629 Sinternal_get_lisp_face_attribute,
4630 2, 3, 0,
4631 doc: /* Return face attribute KEYWORD of face SYMBOL.
4632 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4633 face attribute name, signal an error.
4634 If the optional argument FRAME is given, report on face FACE in that
4635 frame. If FRAME is t, report on the defaults for face FACE (for new
4636 frames). If FRAME is omitted or nil, use the selected frame. */)
4637 (symbol, keyword, frame)
4638 Lisp_Object symbol, keyword, frame;
4640 Lisp_Object lface, value = Qnil;
4642 CHECK_SYMBOL (symbol);
4643 CHECK_SYMBOL (keyword);
4645 if (EQ (frame, Qt))
4646 lface = lface_from_face_name (NULL, symbol, 1);
4647 else
4649 if (NILP (frame))
4650 frame = selected_frame;
4651 CHECK_LIVE_FRAME (frame);
4652 lface = lface_from_face_name (XFRAME (frame), symbol, 1);
4655 if (EQ (keyword, QCfamily))
4656 value = LFACE_FAMILY (lface);
4657 else if (EQ (keyword, QCheight))
4658 value = LFACE_HEIGHT (lface);
4659 else if (EQ (keyword, QCweight))
4660 value = LFACE_WEIGHT (lface);
4661 else if (EQ (keyword, QCslant))
4662 value = LFACE_SLANT (lface);
4663 else if (EQ (keyword, QCunderline))
4664 value = LFACE_UNDERLINE (lface);
4665 else if (EQ (keyword, QCoverline))
4666 value = LFACE_OVERLINE (lface);
4667 else if (EQ (keyword, QCstrike_through))
4668 value = LFACE_STRIKE_THROUGH (lface);
4669 else if (EQ (keyword, QCbox))
4670 value = LFACE_BOX (lface);
4671 else if (EQ (keyword, QCinverse_video)
4672 || EQ (keyword, QCreverse_video))
4673 value = LFACE_INVERSE (lface);
4674 else if (EQ (keyword, QCforeground))
4675 value = LFACE_FOREGROUND (lface);
4676 else if (EQ (keyword, QCbackground))
4677 value = LFACE_BACKGROUND (lface);
4678 else if (EQ (keyword, QCstipple))
4679 value = LFACE_STIPPLE (lface);
4680 else if (EQ (keyword, QCwidth))
4681 value = LFACE_SWIDTH (lface);
4682 else if (EQ (keyword, QCinherit))
4683 value = LFACE_INHERIT (lface);
4684 else if (EQ (keyword, QCfont))
4685 value = LFACE_FONT (lface);
4686 else
4687 signal_error ("Invalid face attribute name", keyword);
4689 return value;
4693 DEFUN ("internal-lisp-face-attribute-values",
4694 Finternal_lisp_face_attribute_values,
4695 Sinternal_lisp_face_attribute_values, 1, 1, 0,
4696 doc: /* Return a list of valid discrete values for face attribute ATTR.
4697 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4698 (attr)
4699 Lisp_Object attr;
4701 Lisp_Object result = Qnil;
4703 CHECK_SYMBOL (attr);
4705 if (EQ (attr, QCweight)
4706 || EQ (attr, QCslant)
4707 || EQ (attr, QCwidth))
4709 /* Extract permissible symbols from tables. */
4710 struct table_entry *table;
4711 int i, dim;
4713 if (EQ (attr, QCweight))
4714 table = weight_table, dim = DIM (weight_table);
4715 else if (EQ (attr, QCslant))
4716 table = slant_table, dim = DIM (slant_table);
4717 else
4718 table = swidth_table, dim = DIM (swidth_table);
4720 for (i = 0; i < dim; ++i)
4722 Lisp_Object symbol = *table[i].symbol;
4723 Lisp_Object tail = result;
4725 while (!NILP (tail)
4726 && !EQ (XCAR (tail), symbol))
4727 tail = XCDR (tail);
4729 if (NILP (tail))
4730 result = Fcons (symbol, result);
4733 else if (EQ (attr, QCunderline))
4734 result = Fcons (Qt, Fcons (Qnil, Qnil));
4735 else if (EQ (attr, QCoverline))
4736 result = Fcons (Qt, Fcons (Qnil, Qnil));
4737 else if (EQ (attr, QCstrike_through))
4738 result = Fcons (Qt, Fcons (Qnil, Qnil));
4739 else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
4740 result = Fcons (Qt, Fcons (Qnil, Qnil));
4742 return result;
4746 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face,
4747 Sinternal_merge_in_global_face, 2, 2, 0,
4748 doc: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4749 Default face attributes override any local face attributes. */)
4750 (face, frame)
4751 Lisp_Object face, frame;
4753 int i;
4754 Lisp_Object global_lface, local_lface, *gvec, *lvec;
4756 CHECK_LIVE_FRAME (frame);
4757 global_lface = lface_from_face_name (NULL, face, 1);
4758 local_lface = lface_from_face_name (XFRAME (frame), face, 0);
4759 if (NILP (local_lface))
4760 local_lface = Finternal_make_lisp_face (face, frame);
4762 /* Make every specified global attribute override the local one.
4763 BEWARE!! This is only used from `face-set-after-frame-default' where
4764 the local frame is defined from default specs in `face-defface-spec'
4765 and those should be overridden by global settings. Hence the strange
4766 "global before local" priority. */
4767 lvec = XVECTOR (local_lface)->contents;
4768 gvec = XVECTOR (global_lface)->contents;
4769 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
4770 if (! UNSPECIFIEDP (gvec[i]))
4771 lvec[i] = gvec[i];
4773 return Qnil;
4777 /* The following function is implemented for compatibility with 20.2.
4778 The function is used in x-resolve-fonts when it is asked to
4779 return fonts with the same size as the font of a face. This is
4780 done in fontset.el. */
4782 DEFUN ("face-font", Fface_font, Sface_font, 1, 2, 0,
4783 doc: /* Return the font name of face FACE, or nil if it is unspecified.
4784 If the optional argument FRAME is given, report on face FACE in that frame.
4785 If FRAME is t, report on the defaults for face FACE (for new frames).
4786 The font default for a face is either nil, or a list
4787 of the form (bold), (italic) or (bold italic).
4788 If FRAME is omitted or nil, use the selected frame. */)
4789 (face, frame)
4790 Lisp_Object face, frame;
4792 if (EQ (frame, Qt))
4794 Lisp_Object result = Qnil;
4795 Lisp_Object lface = lface_from_face_name (NULL, face, 1);
4797 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface))
4798 && !EQ (LFACE_WEIGHT (lface), Qnormal))
4799 result = Fcons (Qbold, result);
4801 if (!UNSPECIFIEDP (LFACE_SLANT (lface))
4802 && !EQ (LFACE_SLANT (lface), Qnormal))
4803 result = Fcons (Qitalic, result);
4805 return result;
4807 else
4809 struct frame *f = frame_or_selected_frame (frame, 1);
4810 int face_id = lookup_named_face (f, face, 0);
4811 struct face *face = FACE_FROM_ID (f, face_id);
4812 return face ? build_string (face->font_name) : Qnil;
4817 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4818 all attributes are `equal'. Tries to be fast because this function
4819 is called quite often. */
4821 static INLINE int
4822 lface_equal_p (v1, v2)
4823 Lisp_Object *v1, *v2;
4825 int i, equal_p = 1;
4827 for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i)
4829 Lisp_Object a = v1[i];
4830 Lisp_Object b = v2[i];
4832 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4833 and the other is specified. */
4834 equal_p = XTYPE (a) == XTYPE (b);
4835 if (!equal_p)
4836 break;
4838 if (!EQ (a, b))
4840 switch (XTYPE (a))
4842 case Lisp_String:
4843 equal_p = ((SBYTES (a)
4844 == SBYTES (b))
4845 && bcmp (SDATA (a), SDATA (b),
4846 SBYTES (a)) == 0);
4847 break;
4849 case Lisp_Int:
4850 case Lisp_Symbol:
4851 equal_p = 0;
4852 break;
4854 default:
4855 equal_p = !NILP (Fequal (a, b));
4856 break;
4861 return equal_p;
4865 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p,
4866 Sinternal_lisp_face_equal_p, 2, 3, 0,
4867 doc: /* True if FACE1 and FACE2 are equal.
4868 If the optional argument FRAME is given, report on face FACE in that frame.
4869 If FRAME is t, report on the defaults for face FACE (for new frames).
4870 If FRAME is omitted or nil, use the selected frame. */)
4871 (face1, face2, frame)
4872 Lisp_Object face1, face2, frame;
4874 int equal_p;
4875 struct frame *f;
4876 Lisp_Object lface1, lface2;
4878 if (EQ (frame, Qt))
4879 f = NULL;
4880 else
4881 /* Don't use check_x_frame here because this function is called
4882 before X frames exist. At that time, if FRAME is nil,
4883 selected_frame will be used which is the frame dumped with
4884 Emacs. That frame is not an X frame. */
4885 f = frame_or_selected_frame (frame, 2);
4887 lface1 = lface_from_face_name (NULL, face1, 1);
4888 lface2 = lface_from_face_name (NULL, face2, 1);
4889 equal_p = lface_equal_p (XVECTOR (lface1)->contents,
4890 XVECTOR (lface2)->contents);
4891 return equal_p ? Qt : Qnil;
4895 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p,
4896 Sinternal_lisp_face_empty_p, 1, 2, 0,
4897 doc: /* True if FACE has no attribute specified.
4898 If the optional argument FRAME is given, report on face FACE in that frame.
4899 If FRAME is t, report on the defaults for face FACE (for new frames).
4900 If FRAME is omitted or nil, use the selected frame. */)
4901 (face, frame)
4902 Lisp_Object face, frame;
4904 struct frame *f;
4905 Lisp_Object lface;
4906 int i;
4908 if (NILP (frame))
4909 frame = selected_frame;
4910 CHECK_LIVE_FRAME (frame);
4911 f = XFRAME (frame);
4913 if (EQ (frame, Qt))
4914 lface = lface_from_face_name (NULL, face, 1);
4915 else
4916 lface = lface_from_face_name (f, face, 1);
4918 for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
4919 if (!UNSPECIFIEDP (AREF (lface, i)))
4920 break;
4922 return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
4926 DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
4927 0, 1, 0,
4928 doc: /* Return an alist of frame-local faces defined on FRAME.
4929 For internal use only. */)
4930 (frame)
4931 Lisp_Object frame;
4933 struct frame *f = frame_or_selected_frame (frame, 0);
4934 return f->face_alist;
4938 /* Return a hash code for Lisp string STRING with case ignored. Used
4939 below in computing a hash value for a Lisp face. */
4941 static INLINE unsigned
4942 hash_string_case_insensitive (string)
4943 Lisp_Object string;
4945 const unsigned char *s;
4946 unsigned hash = 0;
4947 xassert (STRINGP (string));
4948 for (s = SDATA (string); *s; ++s)
4949 hash = (hash << 1) ^ tolower (*s);
4950 return hash;
4954 /* Return a hash code for face attribute vector V. */
4956 static INLINE unsigned
4957 lface_hash (v)
4958 Lisp_Object *v;
4960 return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
4961 ^ hash_string_case_insensitive (v[LFACE_FOREGROUND_INDEX])
4962 ^ hash_string_case_insensitive (v[LFACE_BACKGROUND_INDEX])
4963 ^ XFASTINT (v[LFACE_WEIGHT_INDEX])
4964 ^ XFASTINT (v[LFACE_SLANT_INDEX])
4965 ^ XFASTINT (v[LFACE_SWIDTH_INDEX])
4966 ^ XFASTINT (v[LFACE_HEIGHT_INDEX]));
4970 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4971 considering charsets/registries). They do if they specify the same
4972 family, point size, weight, width, slant, and fontset. Both LFACE1
4973 and LFACE2 must be fully-specified. */
4975 static INLINE int
4976 lface_same_font_attributes_p (lface1, lface2)
4977 Lisp_Object *lface1, *lface2;
4979 xassert (lface_fully_specified_p (lface1)
4980 && lface_fully_specified_p (lface2));
4981 return (xstricmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
4982 SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
4983 && EQ (lface1[LFACE_HEIGHT_INDEX], lface2[LFACE_HEIGHT_INDEX])
4984 && EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
4985 && EQ (lface1[LFACE_AVGWIDTH_INDEX], lface2[LFACE_AVGWIDTH_INDEX])
4986 && EQ (lface1[LFACE_WEIGHT_INDEX], lface2[LFACE_WEIGHT_INDEX])
4987 && EQ (lface1[LFACE_SLANT_INDEX], lface2[LFACE_SLANT_INDEX])
4988 && (EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
4989 || (STRINGP (lface1[LFACE_FONT_INDEX])
4990 && STRINGP (lface2[LFACE_FONT_INDEX])
4991 && xstricmp (SDATA (lface1[LFACE_FONT_INDEX]),
4992 SDATA (lface2[LFACE_FONT_INDEX])))));
4997 /***********************************************************************
4998 Realized Faces
4999 ***********************************************************************/
5001 /* Allocate and return a new realized face for Lisp face attribute
5002 vector ATTR. */
5004 static struct face *
5005 make_realized_face (attr)
5006 Lisp_Object *attr;
5008 struct face *face = (struct face *) xmalloc (sizeof *face);
5009 bzero (face, sizeof *face);
5010 face->ascii_face = face;
5011 bcopy (attr, face->lface, sizeof face->lface);
5012 return face;
5016 /* Free realized face FACE, including its X resources. FACE may
5017 be null. */
5019 static void
5020 free_realized_face (f, face)
5021 struct frame *f;
5022 struct face *face;
5024 if (face)
5026 #ifdef HAVE_WINDOW_SYSTEM
5027 if (FRAME_WINDOW_P (f))
5029 /* Free fontset of FACE if it is ASCII face. */
5030 if (face->fontset >= 0 && face == face->ascii_face)
5031 free_face_fontset (f, face);
5032 if (face->gc)
5034 x_free_gc (f, face->gc);
5035 face->gc = 0;
5038 free_face_colors (f, face);
5039 x_destroy_bitmap (f, face->stipple);
5041 #endif /* HAVE_WINDOW_SYSTEM */
5043 xfree (face);
5048 /* Prepare face FACE for subsequent display on frame F. This
5049 allocated GCs if they haven't been allocated yet or have been freed
5050 by clearing the face cache. */
5052 void
5053 prepare_face_for_display (f, face)
5054 struct frame *f;
5055 struct face *face;
5057 #ifdef HAVE_WINDOW_SYSTEM
5058 xassert (FRAME_WINDOW_P (f));
5060 if (face->gc == 0)
5062 XGCValues xgcv;
5063 unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures;
5065 xgcv.foreground = face->foreground;
5066 xgcv.background = face->background;
5067 #ifdef HAVE_X_WINDOWS
5068 xgcv.graphics_exposures = False;
5069 #endif
5070 /* The font of FACE may be null if we couldn't load it. */
5071 if (face->font)
5073 #ifdef HAVE_X_WINDOWS
5074 xgcv.font = face->font->fid;
5075 #endif
5076 #ifdef WINDOWSNT
5077 xgcv.font = face->font;
5078 #endif
5079 #ifdef MAC_OS
5080 xgcv.font = face->font;
5081 #endif
5082 mask |= GCFont;
5085 BLOCK_INPUT;
5086 #ifdef HAVE_X_WINDOWS
5087 if (face->stipple)
5089 xgcv.fill_style = FillOpaqueStippled;
5090 xgcv.stipple = x_bitmap_pixmap (f, face->stipple);
5091 mask |= GCFillStyle | GCStipple;
5093 #endif
5094 face->gc = x_create_gc (f, mask, &xgcv);
5095 UNBLOCK_INPUT;
5097 #endif /* HAVE_WINDOW_SYSTEM */
5101 /* Returns the `distance' between the colors X and Y. */
5103 static int
5104 color_distance (x, y)
5105 XColor *x, *y;
5107 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5108 Quoting from that paper:
5110 This formula has results that are very close to L*u*v* (with the
5111 modified lightness curve) and, more importantly, it is a more even
5112 algorithm: it does not have a range of colours where it suddenly
5113 gives far from optimal results.
5115 See <http://www.compuphase.com/cmetric.htm> for more info. */
5117 long r = (x->red - y->red) >> 8;
5118 long g = (x->green - y->green) >> 8;
5119 long b = (x->blue - y->blue) >> 8;
5120 long r_mean = (x->red + y->red) >> 9;
5122 return
5123 (((512 + r_mean) * r * r) >> 8)
5124 + 4 * g * g
5125 + (((767 - r_mean) * b * b) >> 8);
5129 DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
5130 doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5131 COLOR1 and COLOR2 may be either strings containing the color name,
5132 or lists of the form (RED GREEN BLUE).
5133 If FRAME is unspecified or nil, the current frame is used. */)
5134 (color1, color2, frame)
5135 Lisp_Object color1, color2, frame;
5137 struct frame *f;
5138 XColor cdef1, cdef2;
5140 if (NILP (frame))
5141 frame = selected_frame;
5142 CHECK_LIVE_FRAME (frame);
5143 f = XFRAME (frame);
5145 if ((CONSP (color1) && !parse_rgb_list (color1, &cdef1))
5146 || !STRINGP (color1)
5147 || !defined_color (f, SDATA (color1), &cdef1, 0))
5148 signal_error ("Invalid color", color1);
5149 if ((CONSP (color2) && !parse_rgb_list (color2, &cdef2))
5150 || !STRINGP (color2)
5151 || !defined_color (f, SDATA (color2), &cdef2, 0))
5152 signal_error ("Invalid color", color2);
5154 return make_number (color_distance (&cdef1, &cdef2));
5158 /***********************************************************************
5159 Face capability testing for ttys
5160 ***********************************************************************/
5163 /* If the distance (as returned by color_distance) between two colors is
5164 less than this, then they are considered the same, for determining
5165 whether a color is supported or not. The range of values is 0-65535. */
5167 #define TTY_SAME_COLOR_THRESHOLD 10000
5170 DEFUN ("tty-supports-face-attributes-p",
5171 Ftty_supports_face_attributes_p, Stty_supports_face_attributes_p,
5172 1, 2, 0,
5173 doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5174 The optional argument FRAME is the frame on which to test; if it is nil
5175 or unspecified, then the current frame is used. If FRAME is not a tty
5176 frame, then nil is returned.
5178 The definition of `supported' is somewhat heuristic, but basically means
5179 that a face containing all the attributes in ATTRIBUTES, when merged
5180 with the default face for display, can be represented in a way that's
5182 \(1) different in appearance than the default face, and
5183 \(2) `close in spirit' to what the attributes specify, if not exact.
5185 Point (2) implies that a `:weight black' attribute will be satisified
5186 by any terminal that can display bold, and a `:foreground "yellow"' as
5187 long as the terminal can display a yellowish color, but `:slant italic'
5188 will _not_ be satisified by the tty display code's automatic
5189 substitution of a `dim' face for italic. */)
5190 (attributes, frame)
5191 Lisp_Object attributes, frame;
5193 int weight, i;
5194 struct frame *f;
5195 Lisp_Object val, fg, bg;
5196 XColor fg_tty_color, fg_std_color;
5197 XColor bg_tty_color, bg_std_color;
5198 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5199 unsigned test_caps = 0;
5201 if (NILP (frame))
5202 frame = selected_frame;
5203 CHECK_LIVE_FRAME (frame);
5204 f = XFRAME (frame);
5206 for (i = 0; i < LFACE_VECTOR_SIZE; i++)
5207 attrs[i] = Qunspecified;
5208 merge_face_vector_with_property (f, attrs, attributes);
5210 /* This function only works on ttys. */
5211 if (!FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f))
5212 return Qnil;
5214 /* First check some easy-to-check stuff; ttys support none of the
5215 following attributes, so we can just return nil if any are requested. */
5217 /* stipple */
5218 val = attrs[LFACE_STIPPLE_INDEX];
5219 if (!UNSPECIFIEDP (val) && !NILP (val))
5220 return Qnil;
5222 /* font height */
5223 val = attrs[LFACE_HEIGHT_INDEX];
5224 if (!UNSPECIFIEDP (val) && !NILP (val))
5225 return Qnil;
5227 /* font width */
5228 val = attrs[LFACE_SWIDTH_INDEX];
5229 if (!UNSPECIFIEDP (val) && !NILP (val)
5230 && face_numeric_swidth (val) != XLFD_SWIDTH_MEDIUM)
5231 return Qnil;
5233 /* overline */
5234 val = attrs[LFACE_OVERLINE_INDEX];
5235 if (!UNSPECIFIEDP (val) && !NILP (val))
5236 return Qnil;
5238 /* strike-through */
5239 val = attrs[LFACE_STRIKE_THROUGH_INDEX];
5240 if (!UNSPECIFIEDP (val) && !NILP (val))
5241 return Qnil;
5243 /* boxes */
5244 val = attrs[LFACE_BOX_INDEX];
5245 if (!UNSPECIFIEDP (val) && !NILP (val))
5246 return Qnil;
5248 /* slant (italics/oblique); We consider any non-default value
5249 unsupportable on ttys, even though the face code actually `fakes'
5250 them using a dim attribute if possible. This is because the faked
5251 result is too different from what the face specifies. */
5252 val = attrs[LFACE_SLANT_INDEX];
5253 if (!UNSPECIFIEDP (val) && !NILP (val)
5254 && face_numeric_slant (val) != XLFD_SLANT_ROMAN)
5255 return Qnil;
5258 /* Test for terminal `capabilities' (non-color character attributes). */
5260 /* font weight (bold/dim) */
5261 weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
5262 if (weight >= 0)
5264 if (weight > XLFD_WEIGHT_MEDIUM)
5265 test_caps = TTY_CAP_BOLD;
5266 else if (weight < XLFD_WEIGHT_MEDIUM)
5267 test_caps = TTY_CAP_DIM;
5270 /* underlining */
5271 val = attrs[LFACE_UNDERLINE_INDEX];
5272 if (!UNSPECIFIEDP (val) && !NILP (val))
5274 if (STRINGP (val))
5275 return Qnil; /* ttys don't support colored underlines */
5276 else
5277 test_caps |= TTY_CAP_UNDERLINE;
5280 /* inverse video */
5281 val = attrs[LFACE_INVERSE_INDEX];
5282 if (!UNSPECIFIEDP (val) && !NILP (val))
5283 test_caps |= TTY_CAP_INVERSE;
5286 /* Color testing. */
5288 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5289 we use them when calling `tty_capable_p' below, even if the face
5290 specifies no colors. */
5291 fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
5292 bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
5294 /* Check if foreground color is close enough. */
5295 fg = attrs[LFACE_FOREGROUND_INDEX];
5296 if (STRINGP (fg))
5298 if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
5299 return Qnil;
5300 else if (color_distance (&fg_tty_color, &fg_std_color)
5301 > TTY_SAME_COLOR_THRESHOLD)
5302 return Qnil;
5305 /* Check if background color is close enough. */
5306 bg = attrs[LFACE_BACKGROUND_INDEX];
5307 if (STRINGP (bg))
5309 if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
5310 return Qnil;
5311 else if (color_distance (&bg_tty_color, &bg_std_color)
5312 > TTY_SAME_COLOR_THRESHOLD)
5313 return Qnil;
5316 /* If both foreground and background are requested, see if the
5317 distance between them is OK. We just check to see if the distance
5318 between the tty's foreground and background is close enough to the
5319 distance between the standard foreground and background. */
5320 if (STRINGP (fg) && STRINGP (bg))
5322 int delta_delta
5323 = (color_distance (&fg_std_color, &bg_std_color)
5324 - color_distance (&fg_tty_color, &bg_tty_color));
5325 if (delta_delta > TTY_SAME_COLOR_THRESHOLD
5326 || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
5327 return Qnil;
5331 /* See if the capabilities we selected above are supported, with the
5332 given colors. */
5333 if (test_caps != 0 &&
5334 ! tty_capable_p (f, test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
5335 return Qnil;
5338 /* Hmmm, everything checks out, this terminal must support this face. */
5339 return Qt;
5344 /***********************************************************************
5345 Face Cache
5346 ***********************************************************************/
5348 /* Return a new face cache for frame F. */
5350 static struct face_cache *
5351 make_face_cache (f)
5352 struct frame *f;
5354 struct face_cache *c;
5355 int size;
5357 c = (struct face_cache *) xmalloc (sizeof *c);
5358 bzero (c, sizeof *c);
5359 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5360 c->buckets = (struct face **) xmalloc (size);
5361 bzero (c->buckets, size);
5362 c->size = 50;
5363 c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id);
5364 c->f = f;
5365 c->menu_face_changed_p = menu_face_changed_default;
5366 return c;
5370 /* Clear out all graphics contexts for all realized faces, except for
5371 the basic faces. This should be done from time to time just to avoid
5372 keeping too many graphics contexts that are no longer needed. */
5374 static void
5375 clear_face_gcs (c)
5376 struct face_cache *c;
5378 if (c && FRAME_WINDOW_P (c->f))
5380 #ifdef HAVE_WINDOW_SYSTEM
5381 int i;
5382 for (i = BASIC_FACE_ID_SENTINEL; i < c->used; ++i)
5384 struct face *face = c->faces_by_id[i];
5385 if (face && face->gc)
5387 x_free_gc (c->f, face->gc);
5388 face->gc = 0;
5391 #endif /* HAVE_WINDOW_SYSTEM */
5396 /* Free all realized faces in face cache C, including basic faces. C
5397 may be null. If faces are freed, make sure the frame's current
5398 matrix is marked invalid, so that a display caused by an expose
5399 event doesn't try to use faces we destroyed. */
5401 static void
5402 free_realized_faces (c)
5403 struct face_cache *c;
5405 if (c && c->used)
5407 int i, size;
5408 struct frame *f = c->f;
5410 /* We must block input here because we can't process X events
5411 safely while only some faces are freed, or when the frame's
5412 current matrix still references freed faces. */
5413 BLOCK_INPUT;
5415 for (i = 0; i < c->used; ++i)
5417 free_realized_face (f, c->faces_by_id[i]);
5418 c->faces_by_id[i] = NULL;
5421 c->used = 0;
5422 size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5423 bzero (c->buckets, size);
5425 /* Must do a thorough redisplay the next time. Mark current
5426 matrices as invalid because they will reference faces freed
5427 above. This function is also called when a frame is
5428 destroyed. In this case, the root window of F is nil. */
5429 if (WINDOWP (f->root_window))
5431 clear_current_matrices (f);
5432 ++windows_or_buffers_changed;
5435 UNBLOCK_INPUT;
5440 /* Free all faces realized for multibyte characters on frame F that
5441 has FONTSET. */
5443 void
5444 free_realized_multibyte_face (f, fontset)
5445 struct frame *f;
5446 int fontset;
5448 struct face_cache *cache = FRAME_FACE_CACHE (f);
5449 struct face *face;
5450 int i;
5452 /* We must block input here because we can't process X events safely
5453 while only some faces are freed, or when the frame's current
5454 matrix still references freed faces. */
5455 BLOCK_INPUT;
5457 for (i = 0; i < cache->used; i++)
5459 face = cache->faces_by_id[i];
5460 if (face
5461 && face != face->ascii_face
5462 && face->fontset == fontset)
5464 uncache_face (cache, face);
5465 free_realized_face (f, face);
5469 /* Must do a thorough redisplay the next time. Mark current
5470 matrices as invalid because they will reference faces freed
5471 above. This function is also called when a frame is destroyed.
5472 In this case, the root window of F is nil. */
5473 if (WINDOWP (f->root_window))
5475 clear_current_matrices (f);
5476 ++windows_or_buffers_changed;
5479 UNBLOCK_INPUT;
5483 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5484 This is done after attributes of a named face have been changed,
5485 because we can't tell which realized faces depend on that face. */
5487 void
5488 free_all_realized_faces (frame)
5489 Lisp_Object frame;
5491 if (NILP (frame))
5493 Lisp_Object rest;
5494 FOR_EACH_FRAME (rest, frame)
5495 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
5497 else
5498 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
5502 /* Free face cache C and faces in it, including their X resources. */
5504 static void
5505 free_face_cache (c)
5506 struct face_cache *c;
5508 if (c)
5510 free_realized_faces (c);
5511 xfree (c->buckets);
5512 xfree (c->faces_by_id);
5513 xfree (c);
5518 /* Cache realized face FACE in face cache C. HASH is the hash value
5519 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5520 collision list of the face hash table of C. This is done because
5521 otherwise lookup_face would find FACE for every character, even if
5522 faces with the same attributes but for specific characters exist. */
5524 static void
5525 cache_face (c, face, hash)
5526 struct face_cache *c;
5527 struct face *face;
5528 unsigned hash;
5530 int i = hash % FACE_CACHE_BUCKETS_SIZE;
5532 face->hash = hash;
5534 if (face->fontset >= 0)
5536 struct face *last = c->buckets[i];
5537 if (last)
5539 while (last->next)
5540 last = last->next;
5541 last->next = face;
5542 face->prev = last;
5543 face->next = NULL;
5545 else
5547 c->buckets[i] = face;
5548 face->prev = face->next = NULL;
5551 else
5553 face->prev = NULL;
5554 face->next = c->buckets[i];
5555 if (face->next)
5556 face->next->prev = face;
5557 c->buckets[i] = face;
5560 /* Find a free slot in C->faces_by_id and use the index of the free
5561 slot as FACE->id. */
5562 for (i = 0; i < c->used; ++i)
5563 if (c->faces_by_id[i] == NULL)
5564 break;
5565 face->id = i;
5567 /* Maybe enlarge C->faces_by_id. */
5568 if (i == c->used && c->used == c->size)
5570 int new_size = 2 * c->size;
5571 int sz = new_size * sizeof *c->faces_by_id;
5572 c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
5573 c->size = new_size;
5576 #if GLYPH_DEBUG
5577 /* Check that FACE got a unique id. */
5579 int j, n;
5580 struct face *face;
5582 for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j)
5583 for (face = c->buckets[j]; face; face = face->next)
5584 if (face->id == i)
5585 ++n;
5587 xassert (n == 1);
5589 #endif /* GLYPH_DEBUG */
5591 c->faces_by_id[i] = face;
5592 if (i == c->used)
5593 ++c->used;
5597 /* Remove face FACE from cache C. */
5599 static void
5600 uncache_face (c, face)
5601 struct face_cache *c;
5602 struct face *face;
5604 int i = face->hash % FACE_CACHE_BUCKETS_SIZE;
5606 if (face->prev)
5607 face->prev->next = face->next;
5608 else
5609 c->buckets[i] = face->next;
5611 if (face->next)
5612 face->next->prev = face->prev;
5614 c->faces_by_id[face->id] = NULL;
5615 if (face->id == c->used)
5616 --c->used;
5620 /* Look up a realized face with face attributes ATTR in the face cache
5621 of frame F. The face will be used to display character C. Value
5622 is the ID of the face found. If no suitable face is found, realize
5623 a new one. In that case, if C is a multibyte character, BASE_FACE
5624 is a face that has the same attributes. */
5626 INLINE int
5627 lookup_face (f, attr, c, base_face)
5628 struct frame *f;
5629 Lisp_Object *attr;
5630 int c;
5631 struct face *base_face;
5633 struct face_cache *cache = FRAME_FACE_CACHE (f);
5634 unsigned hash;
5635 int i;
5636 struct face *face;
5638 xassert (cache != NULL);
5639 check_lface_attrs (attr);
5641 /* Look up ATTR in the face cache. */
5642 hash = lface_hash (attr);
5643 i = hash % FACE_CACHE_BUCKETS_SIZE;
5645 for (face = cache->buckets[i]; face; face = face->next)
5646 if (face->hash == hash
5647 && (!FRAME_WINDOW_P (f)
5648 || FACE_SUITABLE_FOR_CHAR_P (face, c))
5649 && lface_equal_p (face->lface, attr))
5650 break;
5652 /* If not found, realize a new face. */
5653 if (face == NULL)
5654 face = realize_face (cache, attr, c, base_face, -1);
5656 #if GLYPH_DEBUG
5657 xassert (face == FACE_FROM_ID (f, face->id));
5659 /* When this function is called from face_for_char (in this case, C is
5660 a multibyte character), a fontset of a face returned by
5661 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5662 C) is not sutisfied. The fontset is set for this face by
5663 face_for_char later. */
5664 #if 0
5665 if (FRAME_WINDOW_P (f))
5666 xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
5667 #endif
5668 #endif /* GLYPH_DEBUG */
5670 return face->id;
5674 /* Return the face id of the realized face for named face SYMBOL on
5675 frame F suitable for displaying character C. Value is -1 if the
5676 face couldn't be determined, which might happen if the default face
5677 isn't realized and cannot be realized. */
5680 lookup_named_face (f, symbol, c)
5681 struct frame *f;
5682 Lisp_Object symbol;
5683 int c;
5685 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5686 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
5687 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5689 if (default_face == NULL)
5691 if (!realize_basic_faces (f))
5692 return -1;
5693 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5696 get_lface_attributes (f, symbol, symbol_attrs, 1);
5697 bcopy (default_face->lface, attrs, sizeof attrs);
5698 merge_face_vectors (f, symbol_attrs, attrs, Qnil);
5699 return lookup_face (f, attrs, c, NULL);
5703 /* Return the ID of the realized ASCII face of Lisp face with ID
5704 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5707 ascii_face_of_lisp_face (f, lface_id)
5708 struct frame *f;
5709 int lface_id;
5711 int face_id;
5713 if (lface_id >= 0 && lface_id < lface_id_to_name_size)
5715 Lisp_Object face_name = lface_id_to_name[lface_id];
5716 face_id = lookup_named_face (f, face_name, 0);
5718 else
5719 face_id = -1;
5721 return face_id;
5725 /* Return a face for charset ASCII that is like the face with id
5726 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5727 STEPS < 0 means larger. Value is the id of the face. */
5730 smaller_face (f, face_id, steps)
5731 struct frame *f;
5732 int face_id, steps;
5734 #ifdef HAVE_WINDOW_SYSTEM
5735 struct face *face;
5736 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5737 int pt, last_pt, last_height;
5738 int delta;
5739 int new_face_id;
5740 struct face *new_face;
5742 /* If not called for an X frame, just return the original face. */
5743 if (FRAME_TERMCAP_P (f))
5744 return face_id;
5746 /* Try in increments of 1/2 pt. */
5747 delta = steps < 0 ? 5 : -5;
5748 steps = abs (steps);
5750 face = FACE_FROM_ID (f, face_id);
5751 bcopy (face->lface, attrs, sizeof attrs);
5752 pt = last_pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
5753 new_face_id = face_id;
5754 last_height = FONT_HEIGHT (face->font);
5756 while (steps
5757 && pt + delta > 0
5758 /* Give up if we cannot find a font within 10pt. */
5759 && abs (last_pt - pt) < 100)
5761 /* Look up a face for a slightly smaller/larger font. */
5762 pt += delta;
5763 attrs[LFACE_HEIGHT_INDEX] = make_number (pt);
5764 new_face_id = lookup_face (f, attrs, 0, NULL);
5765 new_face = FACE_FROM_ID (f, new_face_id);
5767 /* If height changes, count that as one step. */
5768 if ((delta < 0 && FONT_HEIGHT (new_face->font) < last_height)
5769 || (delta > 0 && FONT_HEIGHT (new_face->font) > last_height))
5771 --steps;
5772 last_height = FONT_HEIGHT (new_face->font);
5773 last_pt = pt;
5777 return new_face_id;
5779 #else /* not HAVE_WINDOW_SYSTEM */
5781 return face_id;
5783 #endif /* not HAVE_WINDOW_SYSTEM */
5787 /* Return a face for charset ASCII that is like the face with id
5788 FACE_ID on frame F, but has height HEIGHT. */
5791 face_with_height (f, face_id, height)
5792 struct frame *f;
5793 int face_id;
5794 int height;
5796 #ifdef HAVE_WINDOW_SYSTEM
5797 struct face *face;
5798 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5800 if (FRAME_TERMCAP_P (f)
5801 || height <= 0)
5802 return face_id;
5804 face = FACE_FROM_ID (f, face_id);
5805 bcopy (face->lface, attrs, sizeof attrs);
5806 attrs[LFACE_HEIGHT_INDEX] = make_number (height);
5807 face_id = lookup_face (f, attrs, 0, NULL);
5808 #endif /* HAVE_WINDOW_SYSTEM */
5810 return face_id;
5814 /* Return the face id of the realized face for named face SYMBOL on
5815 frame F suitable for displaying character C, and use attributes of
5816 the face FACE_ID for attributes that aren't completely specified by
5817 SYMBOL. This is like lookup_named_face, except that the default
5818 attributes come from FACE_ID, not from the default face. FACE_ID
5819 is assumed to be already realized. */
5822 lookup_derived_face (f, symbol, c, face_id)
5823 struct frame *f;
5824 Lisp_Object symbol;
5825 int c;
5826 int face_id;
5828 Lisp_Object attrs[LFACE_VECTOR_SIZE];
5829 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
5830 struct face *default_face = FACE_FROM_ID (f, face_id);
5832 if (!default_face)
5833 abort ();
5835 get_lface_attributes (f, symbol, symbol_attrs, 1);
5836 bcopy (default_face->lface, attrs, sizeof attrs);
5837 merge_face_vectors (f, symbol_attrs, attrs, Qnil);
5838 return lookup_face (f, attrs, c, default_face);
5841 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
5842 Sface_attributes_as_vector, 1, 1, 0,
5843 doc: /* Return a vector of face attributes corresponding to PLIST. */)
5844 (plist)
5845 Lisp_Object plist;
5847 Lisp_Object lface;
5848 lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
5849 Qunspecified);
5850 merge_face_vector_with_property (XFRAME (selected_frame),
5851 XVECTOR (lface)->contents,
5852 plist);
5853 return lface;
5858 /***********************************************************************
5859 Font selection
5860 ***********************************************************************/
5862 DEFUN ("internal-set-font-selection-order",
5863 Finternal_set_font_selection_order,
5864 Sinternal_set_font_selection_order, 1, 1, 0,
5865 doc: /* Set font selection order for face font selection to ORDER.
5866 ORDER must be a list of length 4 containing the symbols `:width',
5867 `:height', `:weight', and `:slant'. Face attributes appearing
5868 first in ORDER are matched first, e.g. if `:height' appears before
5869 `:weight' in ORDER, font selection first tries to find a font with
5870 a suitable height, and then tries to match the font weight.
5871 Value is ORDER. */)
5872 (order)
5873 Lisp_Object order;
5875 Lisp_Object list;
5876 int i;
5877 int indices[DIM (font_sort_order)];
5879 CHECK_LIST (order);
5880 bzero (indices, sizeof indices);
5881 i = 0;
5883 for (list = order;
5884 CONSP (list) && i < DIM (indices);
5885 list = XCDR (list), ++i)
5887 Lisp_Object attr = XCAR (list);
5888 int xlfd;
5890 if (EQ (attr, QCwidth))
5891 xlfd = XLFD_SWIDTH;
5892 else if (EQ (attr, QCheight))
5893 xlfd = XLFD_POINT_SIZE;
5894 else if (EQ (attr, QCweight))
5895 xlfd = XLFD_WEIGHT;
5896 else if (EQ (attr, QCslant))
5897 xlfd = XLFD_SLANT;
5898 else
5899 break;
5901 if (indices[i] != 0)
5902 break;
5903 indices[i] = xlfd;
5906 if (!NILP (list) || i != DIM (indices))
5907 signal_error ("Invalid font sort order", order);
5908 for (i = 0; i < DIM (font_sort_order); ++i)
5909 if (indices[i] == 0)
5910 signal_error ("Invalid font sort order", order);
5912 if (bcmp (indices, font_sort_order, sizeof indices) != 0)
5914 bcopy (indices, font_sort_order, sizeof font_sort_order);
5915 free_all_realized_faces (Qnil);
5918 return Qnil;
5922 DEFUN ("internal-set-alternative-font-family-alist",
5923 Finternal_set_alternative_font_family_alist,
5924 Sinternal_set_alternative_font_family_alist, 1, 1, 0,
5925 doc: /* Define alternative font families to try in face font selection.
5926 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5927 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5928 be found. Value is ALIST. */)
5929 (alist)
5930 Lisp_Object alist;
5932 CHECK_LIST (alist);
5933 Vface_alternative_font_family_alist = alist;
5934 free_all_realized_faces (Qnil);
5935 return alist;
5939 DEFUN ("internal-set-alternative-font-registry-alist",
5940 Finternal_set_alternative_font_registry_alist,
5941 Sinternal_set_alternative_font_registry_alist, 1, 1, 0,
5942 doc: /* Define alternative font registries to try in face font selection.
5943 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5944 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5945 be found. Value is ALIST. */)
5946 (alist)
5947 Lisp_Object alist;
5949 CHECK_LIST (alist);
5950 Vface_alternative_font_registry_alist = alist;
5951 free_all_realized_faces (Qnil);
5952 return alist;
5956 #ifdef HAVE_WINDOW_SYSTEM
5958 /* Value is non-zero if FONT is the name of a scalable font. The
5959 X11R6 XLFD spec says that point size, pixel size, and average width
5960 are zero for scalable fonts. Intlfonts contain at least one
5961 scalable font ("*-muleindian-1") for which this isn't true, so we
5962 just test average width. */
5964 static int
5965 font_scalable_p (font)
5966 struct font_name *font;
5968 char *s = font->fields[XLFD_AVGWIDTH];
5969 return (*s == '0' && *(s + 1) == '\0')
5970 #ifdef WINDOWSNT
5971 /* Windows implementation of XLFD is slightly broken for backward
5972 compatibility with previous broken versions, so test for
5973 wildcards as well as 0. */
5974 || *s == '*'
5975 #endif
5980 /* Ignore the difference of font point size less than this value. */
5982 #define FONT_POINT_SIZE_QUANTUM 5
5984 /* Value is non-zero if FONT1 is a better match for font attributes
5985 VALUES than FONT2. VALUES is an array of face attribute values in
5986 font sort order. COMPARE_PT_P zero means don't compare point
5987 sizes. AVGWIDTH, if not zero, is a specified font average width
5988 to compare with. */
5990 static int
5991 better_font_p (values, font1, font2, compare_pt_p, avgwidth)
5992 int *values;
5993 struct font_name *font1, *font2;
5994 int compare_pt_p, avgwidth;
5996 int i;
5998 for (i = 0; i < DIM (font_sort_order); ++i)
6000 int xlfd_idx = font_sort_order[i];
6002 if (compare_pt_p || xlfd_idx != XLFD_POINT_SIZE)
6004 int delta1, delta2;
6006 if (xlfd_idx == XLFD_POINT_SIZE)
6008 delta1 = abs (values[i] - (font1->numeric[xlfd_idx]
6009 / font1->rescale_ratio));
6010 delta2 = abs (values[i] - (font2->numeric[xlfd_idx]
6011 / font2->rescale_ratio));
6012 if (abs (delta1 - delta2) < FONT_POINT_SIZE_QUANTUM)
6013 continue;
6015 else
6017 delta1 = abs (values[i] - font1->numeric[xlfd_idx]);
6018 delta2 = abs (values[i] - font2->numeric[xlfd_idx]);
6021 if (delta1 > delta2)
6022 return 0;
6023 else if (delta1 < delta2)
6024 return 1;
6025 else
6027 /* The difference may be equal because, e.g., the face
6028 specifies `italic' but we have only `regular' and
6029 `oblique'. Prefer `oblique' in this case. */
6030 if ((xlfd_idx == XLFD_WEIGHT || xlfd_idx == XLFD_SLANT)
6031 && font1->numeric[xlfd_idx] > values[i]
6032 && font2->numeric[xlfd_idx] < values[i])
6033 return 1;
6038 if (avgwidth)
6040 int delta1 = abs (avgwidth - font1->numeric[XLFD_AVGWIDTH]);
6041 int delta2 = abs (avgwidth - font2->numeric[XLFD_AVGWIDTH]);
6042 if (delta1 > delta2)
6043 return 0;
6044 else if (delta1 < delta2)
6045 return 1;
6048 if (! compare_pt_p)
6050 /* We prefer a real scalable font; i.e. not what autoscaled. */
6051 int auto_scaled_1 = (font1->numeric[XLFD_POINT_SIZE] == 0
6052 && font1->numeric[XLFD_RESY] > 0);
6053 int auto_scaled_2 = (font2->numeric[XLFD_POINT_SIZE] == 0
6054 && font2->numeric[XLFD_RESY] > 0);
6056 if (auto_scaled_1 != auto_scaled_2)
6057 return auto_scaled_2;
6060 return font1->registry_priority < font2->registry_priority;
6064 /* Value is non-zero if FONT is an exact match for face attributes in
6065 SPECIFIED. SPECIFIED is an array of face attribute values in font
6066 sort order. AVGWIDTH, if non-zero, is an average width to compare
6067 with. */
6069 static int
6070 exact_face_match_p (specified, font, avgwidth)
6071 int *specified;
6072 struct font_name *font;
6073 int avgwidth;
6075 int i;
6077 for (i = 0; i < DIM (font_sort_order); ++i)
6078 if (specified[i] != font->numeric[font_sort_order[i]])
6079 break;
6081 return (i == DIM (font_sort_order)
6082 && (avgwidth <= 0
6083 || avgwidth == font->numeric[XLFD_AVGWIDTH]));
6087 /* Value is the name of a scaled font, generated from scalable font
6088 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6089 Value is allocated from heap. */
6091 static char *
6092 build_scalable_font_name (f, font, specified_pt)
6093 struct frame *f;
6094 struct font_name *font;
6095 int specified_pt;
6097 char pixel_size[20];
6098 int pixel_value;
6099 double resy = FRAME_X_DISPLAY_INFO (f)->resy;
6100 double pt;
6102 /* If scalable font is for a specific resolution, compute
6103 the point size we must specify from the resolution of
6104 the display and the specified resolution of the font. */
6105 if (font->numeric[XLFD_RESY] != 0)
6107 pt = resy / font->numeric[XLFD_RESY] * specified_pt + 0.5;
6108 pixel_value = font->numeric[XLFD_RESY] / (PT_PER_INCH * 10.0) * pt;
6110 else
6112 pt = specified_pt;
6113 pixel_value = resy / (PT_PER_INCH * 10.0) * pt;
6115 /* We may need a font of the different size. */
6116 pixel_value *= font->rescale_ratio;
6118 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6119 font of the specified PIXEL_SIZE. */
6120 #if 0
6121 { /* Set point size of the font. */
6122 char point_size[20];
6123 sprintf (point_size, "%d", (int) pt);
6124 font->fields[XLFD_POINT_SIZE] = point_size;
6125 font->numeric[XLFD_POINT_SIZE] = pt;
6127 #endif
6129 /* Set pixel size. */
6130 sprintf (pixel_size, "%d", pixel_value);
6131 font->fields[XLFD_PIXEL_SIZE] = pixel_size;
6132 font->numeric[XLFD_PIXEL_SIZE] = pixel_value;
6134 /* If font doesn't specify its resolution, use the
6135 resolution of the display. */
6136 if (font->numeric[XLFD_RESY] == 0)
6138 char buffer[20];
6139 sprintf (buffer, "%d", (int) resy);
6140 font->fields[XLFD_RESY] = buffer;
6141 font->numeric[XLFD_RESY] = resy;
6144 if (strcmp (font->fields[XLFD_RESX], "0") == 0)
6146 char buffer[20];
6147 int resx = FRAME_X_DISPLAY_INFO (f)->resx;
6148 sprintf (buffer, "%d", resx);
6149 font->fields[XLFD_RESX] = buffer;
6150 font->numeric[XLFD_RESX] = resx;
6153 return build_font_name (font);
6157 /* Value is non-zero if we are allowed to use scalable font FONT. We
6158 can't run a Lisp function here since this function may be called
6159 with input blocked. */
6161 static int
6162 may_use_scalable_font_p (font)
6163 const char *font;
6165 if (EQ (Vscalable_fonts_allowed, Qt))
6166 return 1;
6167 else if (CONSP (Vscalable_fonts_allowed))
6169 Lisp_Object tail, regexp;
6171 for (tail = Vscalable_fonts_allowed; CONSP (tail); tail = XCDR (tail))
6173 regexp = XCAR (tail);
6174 if (STRINGP (regexp)
6175 && fast_c_string_match_ignore_case (regexp, font) >= 0)
6176 return 1;
6180 return 0;
6185 /* Return the name of the best matching font for face attributes ATTRS
6186 in the array of font_name structures FONTS which contains NFONTS
6187 elements. WIDTH_RATIO is a factor with which to multiply average
6188 widths if ATTRS specifies such a width.
6190 Value is a font name which is allocated from the heap. FONTS is
6191 freed by this function.
6193 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6194 indicate whether the resulting font should be drawn using overstrike
6195 to simulate bold-face. */
6197 static char *
6198 best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike)
6199 struct frame *f;
6200 Lisp_Object *attrs;
6201 struct font_name *fonts;
6202 int nfonts;
6203 int width_ratio;
6204 int *needs_overstrike;
6206 char *font_name;
6207 struct font_name *best;
6208 int i, pt = 0;
6209 int specified[5];
6210 int exact_p, avgwidth;
6212 if (nfonts == 0)
6213 return NULL;
6215 /* Make specified font attributes available in `specified',
6216 indexed by sort order. */
6217 for (i = 0; i < DIM (font_sort_order); ++i)
6219 int xlfd_idx = font_sort_order[i];
6221 if (xlfd_idx == XLFD_SWIDTH)
6222 specified[i] = face_numeric_swidth (attrs[LFACE_SWIDTH_INDEX]);
6223 else if (xlfd_idx == XLFD_POINT_SIZE)
6224 specified[i] = pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
6225 else if (xlfd_idx == XLFD_WEIGHT)
6226 specified[i] = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
6227 else if (xlfd_idx == XLFD_SLANT)
6228 specified[i] = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
6229 else
6230 abort ();
6233 avgwidth = (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])
6235 : XFASTINT (attrs[LFACE_AVGWIDTH_INDEX]) * width_ratio);
6237 exact_p = 0;
6239 if (needs_overstrike)
6240 *needs_overstrike = 0;
6242 /* Start with the first non-scalable font in the list. */
6243 for (i = 0; i < nfonts; ++i)
6244 if (!font_scalable_p (fonts + i))
6245 break;
6247 /* Find the best match among the non-scalable fonts. */
6248 if (i < nfonts)
6250 best = fonts + i;
6252 for (i = 1; i < nfonts; ++i)
6253 if (!font_scalable_p (fonts + i)
6254 && better_font_p (specified, fonts + i, best, 1, avgwidth))
6256 best = fonts + i;
6258 exact_p = exact_face_match_p (specified, best, avgwidth);
6259 if (exact_p)
6260 break;
6263 else
6264 best = NULL;
6266 /* Unless we found an exact match among non-scalable fonts, see if
6267 we can find a better match among scalable fonts. */
6268 if (!exact_p)
6270 /* A scalable font is better if
6272 1. its weight, slant, swidth attributes are better, or.
6274 2. the best non-scalable font doesn't have the required
6275 point size, and the scalable fonts weight, slant, swidth
6276 isn't worse. */
6278 int non_scalable_has_exact_height_p;
6280 if (best && best->numeric[XLFD_POINT_SIZE] == pt)
6281 non_scalable_has_exact_height_p = 1;
6282 else
6283 non_scalable_has_exact_height_p = 0;
6285 for (i = 0; i < nfonts; ++i)
6286 if (font_scalable_p (fonts + i))
6288 if (best == NULL
6289 || better_font_p (specified, fonts + i, best, 0, 0)
6290 || (!non_scalable_has_exact_height_p
6291 && !better_font_p (specified, best, fonts + i, 0, 0)))
6293 non_scalable_has_exact_height_p = 1;
6294 best = fonts + i;
6298 if (needs_overstrike)
6300 enum xlfd_weight want_weight = specified[XLFD_WEIGHT];
6301 enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT];
6303 if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight)
6305 /* We want a bold font, but didn't get one; try to use
6306 overstriking instead to simulate bold-face. However,
6307 don't overstrike an already-bold fontn unless the
6308 desired weight grossly exceeds the available weight. */
6309 if (got_weight > XLFD_WEIGHT_MEDIUM)
6310 *needs_overstrike = (got_weight - want_weight) > 2;
6311 else
6312 *needs_overstrike = 1;
6317 if (font_scalable_p (best))
6318 font_name = build_scalable_font_name (f, best, pt);
6319 else
6320 font_name = build_font_name (best);
6322 /* Free font_name structures. */
6323 free_font_names (fonts, nfonts);
6325 return font_name;
6329 /* Get a list of matching fonts on frame F, considering FAMILY
6330 and alternative font families from Vface_alternative_font_registry_alist.
6332 FAMILY is the font family whose alternatives are considered.
6334 REGISTRY, if a string, specifies a font registry and encoding to
6335 match. A value of nil means include fonts of any registry and
6336 encoding.
6338 Return in *FONTS a pointer to a vector of font_name structures for
6339 the fonts matched. Value is the number of fonts found. */
6341 static int
6342 try_alternative_families (f, family, registry, fonts)
6343 struct frame *f;
6344 Lisp_Object family, registry;
6345 struct font_name **fonts;
6347 Lisp_Object alter;
6348 int nfonts = 0;
6350 nfonts = font_list (f, Qnil, family, registry, fonts);
6351 if (nfonts == 0)
6353 /* Try alternative font families. */
6354 alter = Fassoc (family, Vface_alternative_font_family_alist);
6355 if (CONSP (alter))
6357 for (alter = XCDR (alter);
6358 CONSP (alter) && nfonts == 0;
6359 alter = XCDR (alter))
6361 if (STRINGP (XCAR (alter)))
6362 nfonts = font_list (f, Qnil, XCAR (alter), registry, fonts);
6366 /* Try all scalable fonts before giving up. */
6367 if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
6369 int count = SPECPDL_INDEX ();
6370 specbind (Qscalable_fonts_allowed, Qt);
6371 nfonts = try_alternative_families (f, family, registry, fonts);
6372 unbind_to (count, Qnil);
6375 return nfonts;
6379 /* Get a list of matching fonts on frame F.
6381 FAMILY, if a string, specifies a font family derived from the fontset.
6382 It is only used if the face does not specify any family in ATTRS or
6383 if we cannot find any font of the face's family.
6385 REGISTRY, if a string, specifies a font registry and encoding to
6386 match. A value of nil means include fonts of any registry and
6387 encoding.
6389 If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
6390 Otherwise, prefer FAMILY.
6392 Return in *FONTS a pointer to a vector of font_name structures for
6393 the fonts matched. Value is the number of fonts found. */
6395 static int
6396 try_font_list (f, attrs, family, registry, fonts, prefer_face_family)
6397 struct frame *f;
6398 Lisp_Object *attrs;
6399 Lisp_Object family, registry;
6400 struct font_name **fonts;
6401 int prefer_face_family;
6403 int nfonts = 0;
6404 Lisp_Object face_family = attrs[LFACE_FAMILY_INDEX];
6405 Lisp_Object try_family;
6407 try_family = (prefer_face_family || NILP (family)) ? face_family : family;
6409 if (STRINGP (try_family))
6410 nfonts = try_alternative_families (f, try_family, registry, fonts);
6412 #ifdef MAC_OS
6413 /* When realizing the default face and a font spec does not matched
6414 exactly, Emacs looks for ones with the same registry as the
6415 default font. On the Mac, this is mac-roman, which does not work
6416 if the family is -etl-fixed, e.g. The following widens the
6417 choices and fixes that problem. */
6418 if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry)
6419 && xstricmp (SDATA (registry), "mac-roman") == 0)
6420 nfonts = try_alternative_families (f, try_family, Qnil, fonts);
6421 #endif
6423 if (EQ (try_family, family))
6424 family = face_family;
6426 if (nfonts == 0 && STRINGP (family))
6427 nfonts = try_alternative_families (f, family, registry, fonts);
6429 /* Try font family of the default face or "fixed". */
6430 if (nfonts == 0)
6432 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6433 if (default_face)
6434 family = default_face->lface[LFACE_FAMILY_INDEX];
6435 else
6436 family = build_string ("fixed");
6437 nfonts = font_list (f, Qnil, family, registry, fonts);
6440 /* Try any family with the given registry. */
6441 if (nfonts == 0)
6442 nfonts = try_alternative_families (f, Qnil, registry, fonts);
6444 return nfonts;
6448 /* Return the fontset id of the base fontset name or alias name given
6449 by the fontset attribute of ATTRS. Value is -1 if the fontset
6450 attribute of ATTRS doesn't name a fontset. */
6452 static int
6453 face_fontset (attrs)
6454 Lisp_Object *attrs;
6456 Lisp_Object name;
6458 name = attrs[LFACE_FONT_INDEX];
6459 if (!STRINGP (name))
6460 return -1;
6461 return fs_query_fontset (name, 0);
6465 /* Choose a name of font to use on frame F to display character C with
6466 Lisp face attributes specified by ATTRS. The font name is
6467 determined by the font-related attributes in ATTRS and the name
6468 pattern for C in FONTSET. Value is the font name which is
6469 allocated from the heap and must be freed by the caller, or NULL if
6470 we can get no information about the font name of C. It is assured
6471 that we always get some information for a single byte
6472 character.
6474 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6475 indicate whether the resulting font should be drawn using overstrike
6476 to simulate bold-face. */
6478 static char *
6479 choose_face_font (f, attrs, fontset, c, needs_overstrike)
6480 struct frame *f;
6481 Lisp_Object *attrs;
6482 int fontset, c;
6483 int *needs_overstrike;
6485 Lisp_Object pattern;
6486 char *font_name = NULL;
6487 struct font_name *fonts;
6488 int nfonts, width_ratio;
6490 if (needs_overstrike)
6491 *needs_overstrike = 0;
6493 /* Get (foundry and) family name and registry (and encoding) name of
6494 a font for C. */
6495 pattern = fontset_font_pattern (f, fontset, c);
6496 if (NILP (pattern))
6498 xassert (!SINGLE_BYTE_CHAR_P (c));
6499 return NULL;
6502 /* If what we got is a name pattern, return it. */
6503 if (STRINGP (pattern))
6504 return xstrdup (SDATA (pattern));
6506 /* Get a list of fonts matching that pattern and choose the
6507 best match for the specified face attributes from it. */
6508 nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts,
6509 (SINGLE_BYTE_CHAR_P (c)
6510 || CHAR_CHARSET (c) == charset_latin_iso8859_1));
6511 width_ratio = (SINGLE_BYTE_CHAR_P (c)
6513 : CHARSET_WIDTH (CHAR_CHARSET (c)));
6514 font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio,
6515 needs_overstrike);
6516 return font_name;
6519 #endif /* HAVE_WINDOW_SYSTEM */
6523 /***********************************************************************
6524 Face Realization
6525 ***********************************************************************/
6527 /* Realize basic faces on frame F. Value is zero if frame parameters
6528 of F don't contain enough information needed to realize the default
6529 face. */
6531 static int
6532 realize_basic_faces (f)
6533 struct frame *f;
6535 int success_p = 0;
6536 int count = SPECPDL_INDEX ();
6538 /* Block input here so that we won't be surprised by an X expose
6539 event, for instance, without having the faces set up. */
6540 BLOCK_INPUT;
6541 specbind (Qscalable_fonts_allowed, Qt);
6543 if (realize_default_face (f))
6545 realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID);
6546 realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID);
6547 realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID);
6548 realize_named_face (f, Qfringe, FRINGE_FACE_ID);
6549 realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID);
6550 realize_named_face (f, Qscroll_bar, SCROLL_BAR_FACE_ID);
6551 realize_named_face (f, Qborder, BORDER_FACE_ID);
6552 realize_named_face (f, Qcursor, CURSOR_FACE_ID);
6553 realize_named_face (f, Qmouse, MOUSE_FACE_ID);
6554 realize_named_face (f, Qmenu, MENU_FACE_ID);
6556 /* Reflect changes in the `menu' face in menu bars. */
6557 if (FRAME_FACE_CACHE (f)->menu_face_changed_p)
6559 FRAME_FACE_CACHE (f)->menu_face_changed_p = 0;
6560 #ifdef USE_X_TOOLKIT
6561 x_update_menu_appearance (f);
6562 #endif
6565 success_p = 1;
6568 unbind_to (count, Qnil);
6569 UNBLOCK_INPUT;
6570 return success_p;
6574 /* Realize the default face on frame F. If the face is not fully
6575 specified, make it fully-specified. Attributes of the default face
6576 that are not explicitly specified are taken from frame parameters. */
6578 static int
6579 realize_default_face (f)
6580 struct frame *f;
6582 struct face_cache *c = FRAME_FACE_CACHE (f);
6583 Lisp_Object lface;
6584 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6585 Lisp_Object frame_font;
6586 struct face *face;
6588 /* If the `default' face is not yet known, create it. */
6589 lface = lface_from_face_name (f, Qdefault, 0);
6590 if (NILP (lface))
6592 Lisp_Object frame;
6593 XSETFRAME (frame, f);
6594 lface = Finternal_make_lisp_face (Qdefault, frame);
6598 #ifdef HAVE_WINDOW_SYSTEM
6599 if (FRAME_WINDOW_P (f))
6601 /* Set frame_font to the value of the `font' frame parameter. */
6602 frame_font = Fassq (Qfont, f->param_alist);
6603 xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font)));
6604 frame_font = XCDR (frame_font);
6605 set_lface_from_font_name (f, lface, frame_font,
6606 f->default_face_done_p, 1);
6607 f->default_face_done_p = 1;
6609 #endif /* HAVE_WINDOW_SYSTEM */
6611 if (!FRAME_WINDOW_P (f))
6613 LFACE_FAMILY (lface) = build_string ("default");
6614 LFACE_SWIDTH (lface) = Qnormal;
6615 LFACE_HEIGHT (lface) = make_number (1);
6616 if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
6617 LFACE_WEIGHT (lface) = Qnormal;
6618 if (UNSPECIFIEDP (LFACE_SLANT (lface)))
6619 LFACE_SLANT (lface) = Qnormal;
6620 LFACE_AVGWIDTH (lface) = Qunspecified;
6623 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
6624 LFACE_UNDERLINE (lface) = Qnil;
6626 if (UNSPECIFIEDP (LFACE_OVERLINE (lface)))
6627 LFACE_OVERLINE (lface) = Qnil;
6629 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface)))
6630 LFACE_STRIKE_THROUGH (lface) = Qnil;
6632 if (UNSPECIFIEDP (LFACE_BOX (lface)))
6633 LFACE_BOX (lface) = Qnil;
6635 if (UNSPECIFIEDP (LFACE_INVERSE (lface)))
6636 LFACE_INVERSE (lface) = Qnil;
6638 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
6640 /* This function is called so early that colors are not yet
6641 set in the frame parameter list. */
6642 Lisp_Object color = Fassq (Qforeground_color, f->param_alist);
6644 if (CONSP (color) && STRINGP (XCDR (color)))
6645 LFACE_FOREGROUND (lface) = XCDR (color);
6646 else if (FRAME_WINDOW_P (f))
6647 return 0;
6648 else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
6649 LFACE_FOREGROUND (lface) = build_string (unspecified_fg);
6650 else
6651 abort ();
6654 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
6656 /* This function is called so early that colors are not yet
6657 set in the frame parameter list. */
6658 Lisp_Object color = Fassq (Qbackground_color, f->param_alist);
6659 if (CONSP (color) && STRINGP (XCDR (color)))
6660 LFACE_BACKGROUND (lface) = XCDR (color);
6661 else if (FRAME_WINDOW_P (f))
6662 return 0;
6663 else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
6664 LFACE_BACKGROUND (lface) = build_string (unspecified_bg);
6665 else
6666 abort ();
6669 if (UNSPECIFIEDP (LFACE_STIPPLE (lface)))
6670 LFACE_STIPPLE (lface) = Qnil;
6672 /* Realize the face; it must be fully-specified now. */
6673 xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
6674 check_lface (lface);
6675 bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs);
6676 face = realize_face (c, attrs, 0, NULL, DEFAULT_FACE_ID);
6677 return 1;
6681 /* Realize basic faces other than the default face in face cache C.
6682 SYMBOL is the face name, ID is the face id the realized face must
6683 have. The default face must have been realized already. */
6685 static void
6686 realize_named_face (f, symbol, id)
6687 struct frame *f;
6688 Lisp_Object symbol;
6689 int id;
6691 struct face_cache *c = FRAME_FACE_CACHE (f);
6692 Lisp_Object lface = lface_from_face_name (f, symbol, 0);
6693 Lisp_Object attrs[LFACE_VECTOR_SIZE];
6694 Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
6695 struct face *new_face;
6697 /* The default face must exist and be fully specified. */
6698 get_lface_attributes (f, Qdefault, attrs, 1);
6699 check_lface_attrs (attrs);
6700 xassert (lface_fully_specified_p (attrs));
6702 /* If SYMBOL isn't know as a face, create it. */
6703 if (NILP (lface))
6705 Lisp_Object frame;
6706 XSETFRAME (frame, f);
6707 lface = Finternal_make_lisp_face (symbol, frame);
6710 /* Merge SYMBOL's face with the default face. */
6711 get_lface_attributes (f, symbol, symbol_attrs, 1);
6712 merge_face_vectors (f, symbol_attrs, attrs, Qnil);
6714 /* Realize the face. */
6715 new_face = realize_face (c, attrs, 0, NULL, id);
6719 /* Realize the fully-specified face with attributes ATTRS in face
6720 cache CACHE for character C. If C is a multibyte character,
6721 BASE_FACE is a face that has the same attributes. Otherwise,
6722 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6723 ID of face to remove before caching the new face. Value is a
6724 pointer to the newly created realized face. */
6726 static struct face *
6727 realize_face (cache, attrs, c, base_face, former_face_id)
6728 struct face_cache *cache;
6729 Lisp_Object *attrs;
6730 int c;
6731 struct face *base_face;
6732 int former_face_id;
6734 struct face *face;
6736 /* LFACE must be fully specified. */
6737 xassert (cache != NULL);
6738 check_lface_attrs (attrs);
6740 if (former_face_id >= 0 && cache->used > former_face_id)
6742 /* Remove the former face. */
6743 struct face *former_face = cache->faces_by_id[former_face_id];
6744 uncache_face (cache, former_face);
6745 free_realized_face (cache->f, former_face);
6748 if (FRAME_WINDOW_P (cache->f))
6749 face = realize_x_face (cache, attrs, c, base_face);
6750 else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
6751 face = realize_tty_face (cache, attrs, c);
6752 else
6753 abort ();
6755 /* Insert the new face. */
6756 cache_face (cache, face, lface_hash (attrs));
6757 #ifdef HAVE_WINDOW_SYSTEM
6758 if (FRAME_WINDOW_P (cache->f) && face->font == NULL)
6759 load_face_font (cache->f, face, c);
6760 #endif /* HAVE_WINDOW_SYSTEM */
6761 return face;
6765 /* Realize the fully-specified face with attributes ATTRS in face
6766 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6767 a multibyte character, BASE_FACE is a face that has the same
6768 attributes. Otherwise, BASE_FACE is ignored. If the new face
6769 doesn't share font with the default face, a fontname is allocated
6770 from the heap and set in `font_name' of the new face, but it is not
6771 yet loaded here. Value is a pointer to the newly created realized
6772 face. */
6774 static struct face *
6775 realize_x_face (cache, attrs, c, base_face)
6776 struct face_cache *cache;
6777 Lisp_Object *attrs;
6778 int c;
6779 struct face *base_face;
6781 #ifdef HAVE_WINDOW_SYSTEM
6782 struct face *face, *default_face;
6783 struct frame *f;
6784 Lisp_Object stipple, overline, strike_through, box;
6786 xassert (FRAME_WINDOW_P (cache->f));
6787 xassert (SINGLE_BYTE_CHAR_P (c)
6788 || base_face);
6790 /* Allocate a new realized face. */
6791 face = make_realized_face (attrs);
6793 f = cache->f;
6795 /* If C is a multibyte character, we share all face attirbutes with
6796 BASE_FACE including the realized fontset. But, we must load a
6797 different font. */
6798 if (!SINGLE_BYTE_CHAR_P (c))
6800 bcopy (base_face, face, sizeof *face);
6801 face->gc = 0;
6803 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6804 face->colors_copied_bitwise_p = 1;
6806 /* to force realize_face to load font */
6807 face->font = NULL;
6808 return face;
6811 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6813 /* Determine the font to use. Most of the time, the font will be
6814 the same as the font of the default face, so try that first. */
6815 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
6816 if (default_face
6817 && FACE_SUITABLE_FOR_CHAR_P (default_face, c)
6818 && lface_same_font_attributes_p (default_face->lface, attrs))
6820 face->font = default_face->font;
6821 face->fontset = default_face->fontset;
6822 face->font_info_id = default_face->font_info_id;
6823 face->font_name = default_face->font_name;
6824 face->ascii_face = face;
6826 /* But, as we can't share the fontset, make a new realized
6827 fontset that has the same base fontset as of the default
6828 face. */
6829 face->fontset
6830 = make_fontset_for_ascii_face (f, default_face->fontset);
6832 else
6834 /* If the face attribute ATTRS specifies a fontset, use it as
6835 the base of a new realized fontset. Otherwise, use the same
6836 base fontset as of the default face. The base determines
6837 registry and encoding of a font. It may also determine
6838 foundry and family. The other fields of font name pattern
6839 are constructed from ATTRS. */
6840 int fontset = face_fontset (attrs);
6842 if ((fontset == -1) && default_face)
6843 fontset = default_face->fontset;
6844 face->fontset = make_fontset_for_ascii_face (f, fontset);
6845 face->font = NULL; /* to force realize_face to load font */
6848 /* Load colors, and set remaining attributes. */
6850 load_face_colors (f, face, attrs);
6852 /* Set up box. */
6853 box = attrs[LFACE_BOX_INDEX];
6854 if (STRINGP (box))
6856 /* A simple box of line width 1 drawn in color given by
6857 the string. */
6858 face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX],
6859 LFACE_BOX_INDEX);
6860 face->box = FACE_SIMPLE_BOX;
6861 face->box_line_width = 1;
6863 else if (INTEGERP (box))
6865 /* Simple box of specified line width in foreground color of the
6866 face. */
6867 xassert (XINT (box) != 0);
6868 face->box = FACE_SIMPLE_BOX;
6869 face->box_line_width = XINT (box);
6870 face->box_color = face->foreground;
6871 face->box_color_defaulted_p = 1;
6873 else if (CONSP (box))
6875 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6876 being one of `raised' or `sunken'. */
6877 face->box = FACE_SIMPLE_BOX;
6878 face->box_color = face->foreground;
6879 face->box_color_defaulted_p = 1;
6880 face->box_line_width = 1;
6882 while (CONSP (box))
6884 Lisp_Object keyword, value;
6886 keyword = XCAR (box);
6887 box = XCDR (box);
6889 if (!CONSP (box))
6890 break;
6891 value = XCAR (box);
6892 box = XCDR (box);
6894 if (EQ (keyword, QCline_width))
6896 if (INTEGERP (value) && XINT (value) != 0)
6897 face->box_line_width = XINT (value);
6899 else if (EQ (keyword, QCcolor))
6901 if (STRINGP (value))
6903 face->box_color = load_color (f, face, value,
6904 LFACE_BOX_INDEX);
6905 face->use_box_color_for_shadows_p = 1;
6908 else if (EQ (keyword, QCstyle))
6910 if (EQ (value, Qreleased_button))
6911 face->box = FACE_RAISED_BOX;
6912 else if (EQ (value, Qpressed_button))
6913 face->box = FACE_SUNKEN_BOX;
6918 /* Text underline, overline, strike-through. */
6920 if (EQ (attrs[LFACE_UNDERLINE_INDEX], Qt))
6922 /* Use default color (same as foreground color). */
6923 face->underline_p = 1;
6924 face->underline_defaulted_p = 1;
6925 face->underline_color = 0;
6927 else if (STRINGP (attrs[LFACE_UNDERLINE_INDEX]))
6929 /* Use specified color. */
6930 face->underline_p = 1;
6931 face->underline_defaulted_p = 0;
6932 face->underline_color
6933 = load_color (f, face, attrs[LFACE_UNDERLINE_INDEX],
6934 LFACE_UNDERLINE_INDEX);
6936 else if (NILP (attrs[LFACE_UNDERLINE_INDEX]))
6938 face->underline_p = 0;
6939 face->underline_defaulted_p = 0;
6940 face->underline_color = 0;
6943 overline = attrs[LFACE_OVERLINE_INDEX];
6944 if (STRINGP (overline))
6946 face->overline_color
6947 = load_color (f, face, attrs[LFACE_OVERLINE_INDEX],
6948 LFACE_OVERLINE_INDEX);
6949 face->overline_p = 1;
6951 else if (EQ (overline, Qt))
6953 face->overline_color = face->foreground;
6954 face->overline_color_defaulted_p = 1;
6955 face->overline_p = 1;
6958 strike_through = attrs[LFACE_STRIKE_THROUGH_INDEX];
6959 if (STRINGP (strike_through))
6961 face->strike_through_color
6962 = load_color (f, face, attrs[LFACE_STRIKE_THROUGH_INDEX],
6963 LFACE_STRIKE_THROUGH_INDEX);
6964 face->strike_through_p = 1;
6966 else if (EQ (strike_through, Qt))
6968 face->strike_through_color = face->foreground;
6969 face->strike_through_color_defaulted_p = 1;
6970 face->strike_through_p = 1;
6973 stipple = attrs[LFACE_STIPPLE_INDEX];
6974 if (!NILP (stipple))
6975 face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
6977 xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
6978 return face;
6979 #endif /* HAVE_WINDOW_SYSTEM */
6983 /* Map a specified color of face FACE on frame F to a tty color index.
6984 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6985 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6986 default foreground/background colors. */
6988 static void
6989 map_tty_color (f, face, idx, defaulted)
6990 struct frame *f;
6991 struct face *face;
6992 enum lface_attribute_index idx;
6993 int *defaulted;
6995 Lisp_Object frame, color, def;
6996 int foreground_p = idx == LFACE_FOREGROUND_INDEX;
6997 unsigned long default_pixel, default_other_pixel, pixel;
6999 xassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
7001 if (foreground_p)
7003 pixel = default_pixel = FACE_TTY_DEFAULT_FG_COLOR;
7004 default_other_pixel = FACE_TTY_DEFAULT_BG_COLOR;
7006 else
7008 pixel = default_pixel = FACE_TTY_DEFAULT_BG_COLOR;
7009 default_other_pixel = FACE_TTY_DEFAULT_FG_COLOR;
7012 XSETFRAME (frame, f);
7013 color = face->lface[idx];
7015 if (STRINGP (color)
7016 && SCHARS (color)
7017 && CONSP (Vtty_defined_color_alist)
7018 && (def = assq_no_quit (color, call1 (Qtty_color_alist, frame)),
7019 CONSP (def)))
7021 /* Associations in tty-defined-color-alist are of the form
7022 (NAME INDEX R G B). We need the INDEX part. */
7023 pixel = XINT (XCAR (XCDR (def)));
7026 if (pixel == default_pixel && STRINGP (color))
7028 pixel = load_color (f, face, color, idx);
7030 #if defined (MSDOS) || defined (WINDOWSNT)
7031 /* If the foreground of the default face is the default color,
7032 use the foreground color defined by the frame. */
7033 #ifdef MSDOS
7034 if (FRAME_MSDOS_P (f))
7036 #endif /* MSDOS */
7037 if (pixel == default_pixel
7038 || pixel == FACE_TTY_DEFAULT_COLOR)
7040 if (foreground_p)
7041 pixel = FRAME_FOREGROUND_PIXEL (f);
7042 else
7043 pixel = FRAME_BACKGROUND_PIXEL (f);
7044 face->lface[idx] = tty_color_name (f, pixel);
7045 *defaulted = 1;
7047 else if (pixel == default_other_pixel)
7049 if (foreground_p)
7050 pixel = FRAME_BACKGROUND_PIXEL (f);
7051 else
7052 pixel = FRAME_FOREGROUND_PIXEL (f);
7053 face->lface[idx] = tty_color_name (f, pixel);
7054 *defaulted = 1;
7056 #ifdef MSDOS
7058 #endif
7059 #endif /* MSDOS or WINDOWSNT */
7062 if (foreground_p)
7063 face->foreground = pixel;
7064 else
7065 face->background = pixel;
7069 /* Realize the fully-specified face with attributes ATTRS in face
7070 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
7071 pointer to the newly created realized face. */
7073 static struct face *
7074 realize_tty_face (cache, attrs, c)
7075 struct face_cache *cache;
7076 Lisp_Object *attrs;
7077 int c;
7079 struct face *face;
7080 int weight, slant;
7081 int face_colors_defaulted = 0;
7082 struct frame *f = cache->f;
7084 /* Frame must be a termcap frame. */
7085 xassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
7087 /* Allocate a new realized face. */
7088 face = make_realized_face (attrs);
7089 face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
7091 /* Map face attributes to TTY appearances. We map slant to
7092 dimmed text because we want italic text to appear differently
7093 and because dimmed text is probably used infrequently. */
7094 weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
7095 slant = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
7097 if (weight > XLFD_WEIGHT_MEDIUM)
7098 face->tty_bold_p = 1;
7099 if (weight < XLFD_WEIGHT_MEDIUM || slant != XLFD_SLANT_ROMAN)
7100 face->tty_dim_p = 1;
7101 if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
7102 face->tty_underline_p = 1;
7103 if (!NILP (attrs[LFACE_INVERSE_INDEX]))
7104 face->tty_reverse_p = 1;
7106 /* Map color names to color indices. */
7107 map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
7108 map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
7110 /* Swap colors if face is inverse-video. If the colors are taken
7111 from the frame colors, they are already inverted, since the
7112 frame-creation function calls x-handle-reverse-video. */
7113 if (face->tty_reverse_p && !face_colors_defaulted)
7115 unsigned long tem = face->foreground;
7116 face->foreground = face->background;
7117 face->background = tem;
7120 if (tty_suppress_bold_inverse_default_colors_p
7121 && face->tty_bold_p
7122 && face->background == FACE_TTY_DEFAULT_FG_COLOR
7123 && face->foreground == FACE_TTY_DEFAULT_BG_COLOR)
7124 face->tty_bold_p = 0;
7126 return face;
7130 DEFUN ("tty-suppress-bold-inverse-default-colors",
7131 Ftty_suppress_bold_inverse_default_colors,
7132 Stty_suppress_bold_inverse_default_colors, 1, 1, 0,
7133 doc: /* Suppress/allow boldness of faces with inverse default colors.
7134 SUPPRESS non-nil means suppress it.
7135 This affects bold faces on TTYs whose foreground is the default background
7136 color of the display and whose background is the default foreground color.
7137 For such faces, the bold face attribute is ignored if this variable
7138 is non-nil. */)
7139 (suppress)
7140 Lisp_Object suppress;
7142 tty_suppress_bold_inverse_default_colors_p = !NILP (suppress);
7143 ++face_change_count;
7144 return suppress;
7149 /***********************************************************************
7150 Computing Faces
7151 ***********************************************************************/
7153 /* Return the ID of the face to use to display character CH with face
7154 property PROP on frame F in current_buffer. */
7157 compute_char_face (f, ch, prop)
7158 struct frame *f;
7159 int ch;
7160 Lisp_Object prop;
7162 int face_id;
7164 if (NILP (current_buffer->enable_multibyte_characters))
7165 ch = 0;
7167 if (NILP (prop))
7169 struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
7170 face_id = FACE_FOR_CHAR (f, face, ch);
7172 else
7174 Lisp_Object attrs[LFACE_VECTOR_SIZE];
7175 struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
7176 bcopy (default_face->lface, attrs, sizeof attrs);
7177 merge_face_vector_with_property (f, attrs, prop);
7178 face_id = lookup_face (f, attrs, ch, NULL);
7181 return face_id;
7184 /* Return the face ID associated with buffer position POS for
7185 displaying ASCII characters. Return in *ENDPTR the position at
7186 which a different face is needed, as far as text properties and
7187 overlays are concerned. W is a window displaying current_buffer.
7189 REGION_BEG, REGION_END delimit the region, so it can be
7190 highlighted.
7192 LIMIT is a position not to scan beyond. That is to limit the time
7193 this function can take.
7195 If MOUSE is non-zero, use the character's mouse-face, not its face.
7197 The face returned is suitable for displaying ASCII characters. */
7200 face_at_buffer_position (w, pos, region_beg, region_end,
7201 endptr, limit, mouse)
7202 struct window *w;
7203 int pos;
7204 int region_beg, region_end;
7205 int *endptr;
7206 int limit;
7207 int mouse;
7209 struct frame *f = XFRAME (w->frame);
7210 Lisp_Object attrs[LFACE_VECTOR_SIZE];
7211 Lisp_Object prop, position;
7212 int i, noverlays;
7213 Lisp_Object *overlay_vec;
7214 Lisp_Object frame;
7215 int endpos;
7216 Lisp_Object propname = mouse ? Qmouse_face : Qface;
7217 Lisp_Object limit1, end;
7218 struct face *default_face;
7220 /* W must display the current buffer. We could write this function
7221 to use the frame and buffer of W, but right now it doesn't. */
7222 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7224 XSETFRAME (frame, f);
7225 XSETFASTINT (position, pos);
7227 endpos = ZV;
7228 if (pos < region_beg && region_beg < endpos)
7229 endpos = region_beg;
7231 /* Get the `face' or `mouse_face' text property at POS, and
7232 determine the next position at which the property changes. */
7233 prop = Fget_text_property (position, propname, w->buffer);
7234 XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
7235 end = Fnext_single_property_change (position, propname, w->buffer, limit1);
7236 if (INTEGERP (end))
7237 endpos = XINT (end);
7239 /* Look at properties from overlays. */
7241 int next_overlay;
7242 int len;
7244 /* First try with room for 40 overlays. */
7245 len = 40;
7246 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
7247 noverlays = overlays_at (pos, 0, &overlay_vec, &len,
7248 &next_overlay, NULL, 0);
7250 /* If there are more than 40, make enough space for all, and try
7251 again. */
7252 if (noverlays > len)
7254 len = noverlays;
7255 overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
7256 noverlays = overlays_at (pos, 0, &overlay_vec, &len,
7257 &next_overlay, NULL, 0);
7260 if (next_overlay < endpos)
7261 endpos = next_overlay;
7264 *endptr = endpos;
7266 default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
7268 /* Optimize common cases where we can use the default face. */
7269 if (noverlays == 0
7270 && NILP (prop)
7271 && !(pos >= region_beg && pos < region_end))
7272 return DEFAULT_FACE_ID;
7274 /* Begin with attributes from the default face. */
7275 bcopy (default_face->lface, attrs, sizeof attrs);
7277 /* Merge in attributes specified via text properties. */
7278 if (!NILP (prop))
7279 merge_face_vector_with_property (f, attrs, prop);
7281 /* Now merge the overlay data. */
7282 noverlays = sort_overlays (overlay_vec, noverlays, w);
7283 for (i = 0; i < noverlays; i++)
7285 Lisp_Object oend;
7286 int oendpos;
7288 prop = Foverlay_get (overlay_vec[i], propname);
7289 if (!NILP (prop))
7290 merge_face_vector_with_property (f, attrs, prop);
7292 oend = OVERLAY_END (overlay_vec[i]);
7293 oendpos = OVERLAY_POSITION (oend);
7294 if (oendpos < endpos)
7295 endpos = oendpos;
7298 /* If in the region, merge in the region face. */
7299 if (pos >= region_beg && pos < region_end)
7301 Lisp_Object region_face = lface_from_face_name (f, Qregion, 0);
7302 merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil);
7304 if (region_end < endpos)
7305 endpos = region_end;
7308 *endptr = endpos;
7310 /* Look up a realized face with the given face attributes,
7311 or realize a new one for ASCII characters. */
7312 return lookup_face (f, attrs, 0, NULL);
7316 /* Compute the face at character position POS in Lisp string STRING on
7317 window W, for ASCII characters.
7319 If STRING is an overlay string, it comes from position BUFPOS in
7320 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7321 not an overlay string. W must display the current buffer.
7322 REGION_BEG and REGION_END give the start and end positions of the
7323 region; both are -1 if no region is visible.
7325 BASE_FACE_ID is the id of a face to merge with. For strings coming
7326 from overlays or the `display' property it is the face at BUFPOS.
7328 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7330 Set *ENDPTR to the next position where to check for faces in
7331 STRING; -1 if the face is constant from POS to the end of the
7332 string.
7334 Value is the id of the face to use. The face returned is suitable
7335 for displaying ASCII characters. */
7338 face_at_string_position (w, string, pos, bufpos, region_beg,
7339 region_end, endptr, base_face_id, mouse_p)
7340 struct window *w;
7341 Lisp_Object string;
7342 int pos, bufpos;
7343 int region_beg, region_end;
7344 int *endptr;
7345 enum face_id base_face_id;
7346 int mouse_p;
7348 Lisp_Object prop, position, end, limit;
7349 struct frame *f = XFRAME (WINDOW_FRAME (w));
7350 Lisp_Object attrs[LFACE_VECTOR_SIZE];
7351 struct face *base_face;
7352 int multibyte_p = STRING_MULTIBYTE (string);
7353 Lisp_Object prop_name = mouse_p ? Qmouse_face : Qface;
7355 /* Get the value of the face property at the current position within
7356 STRING. Value is nil if there is no face property. */
7357 XSETFASTINT (position, pos);
7358 prop = Fget_text_property (position, prop_name, string);
7360 /* Get the next position at which to check for faces. Value of end
7361 is nil if face is constant all the way to the end of the string.
7362 Otherwise it is a string position where to check faces next.
7363 Limit is the maximum position up to which to check for property
7364 changes in Fnext_single_property_change. Strings are usually
7365 short, so set the limit to the end of the string. */
7366 XSETFASTINT (limit, SCHARS (string));
7367 end = Fnext_single_property_change (position, prop_name, string, limit);
7368 if (INTEGERP (end))
7369 *endptr = XFASTINT (end);
7370 else
7371 *endptr = -1;
7373 base_face = FACE_FROM_ID (f, base_face_id);
7374 xassert (base_face);
7376 /* Optimize the default case that there is no face property and we
7377 are not in the region. */
7378 if (NILP (prop)
7379 && (base_face_id != DEFAULT_FACE_ID
7380 /* BUFPOS <= 0 means STRING is not an overlay string, so
7381 that the region doesn't have to be taken into account. */
7382 || bufpos <= 0
7383 || bufpos < region_beg
7384 || bufpos >= region_end)
7385 && (multibyte_p
7386 /* We can't realize faces for different charsets differently
7387 if we don't have fonts, so we can stop here if not working
7388 on a window-system frame. */
7389 || !FRAME_WINDOW_P (f)
7390 || FACE_SUITABLE_FOR_CHAR_P (base_face, 0)))
7391 return base_face->id;
7393 /* Begin with attributes from the base face. */
7394 bcopy (base_face->lface, attrs, sizeof attrs);
7396 /* Merge in attributes specified via text properties. */
7397 if (!NILP (prop))
7398 merge_face_vector_with_property (f, attrs, prop);
7400 /* If in the region, merge in the region face. */
7401 if (bufpos
7402 && bufpos >= region_beg
7403 && bufpos < region_end)
7405 Lisp_Object region_face = lface_from_face_name (f, Qregion, 0);
7406 merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil);
7409 /* Look up a realized face with the given face attributes,
7410 or realize a new one for ASCII characters. */
7411 return lookup_face (f, attrs, 0, NULL);
7416 /***********************************************************************
7417 Tests
7418 ***********************************************************************/
7420 #if GLYPH_DEBUG
7422 /* Print the contents of the realized face FACE to stderr. */
7424 static void
7425 dump_realized_face (face)
7426 struct face *face;
7428 fprintf (stderr, "ID: %d\n", face->id);
7429 #ifdef HAVE_X_WINDOWS
7430 fprintf (stderr, "gc: %d\n", (int) face->gc);
7431 #endif
7432 fprintf (stderr, "foreground: 0x%lx (%s)\n",
7433 face->foreground,
7434 SDATA (face->lface[LFACE_FOREGROUND_INDEX]));
7435 fprintf (stderr, "background: 0x%lx (%s)\n",
7436 face->background,
7437 SDATA (face->lface[LFACE_BACKGROUND_INDEX]));
7438 fprintf (stderr, "font_name: %s (%s)\n",
7439 face->font_name,
7440 SDATA (face->lface[LFACE_FAMILY_INDEX]));
7441 #ifdef HAVE_X_WINDOWS
7442 fprintf (stderr, "font = %p\n", face->font);
7443 #endif
7444 fprintf (stderr, "font_info_id = %d\n", face->font_info_id);
7445 fprintf (stderr, "fontset: %d\n", face->fontset);
7446 fprintf (stderr, "underline: %d (%s)\n",
7447 face->underline_p,
7448 SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
7449 fprintf (stderr, "hash: %d\n", face->hash);
7450 fprintf (stderr, "charset: %d\n", face->charset);
7454 DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: /* */)
7456 Lisp_Object n;
7458 if (NILP (n))
7460 int i;
7462 fprintf (stderr, "font selection order: ");
7463 for (i = 0; i < DIM (font_sort_order); ++i)
7464 fprintf (stderr, "%d ", font_sort_order[i]);
7465 fprintf (stderr, "\n");
7467 fprintf (stderr, "alternative fonts: ");
7468 debug_print (Vface_alternative_font_family_alist);
7469 fprintf (stderr, "\n");
7471 for (i = 0; i < FRAME_FACE_CACHE (SELECTED_FRAME ())->used; ++i)
7472 Fdump_face (make_number (i));
7474 else
7476 struct face *face;
7477 CHECK_NUMBER (n);
7478 face = FACE_FROM_ID (SELECTED_FRAME (), XINT (n));
7479 if (face == NULL)
7480 error ("Not a valid face");
7481 dump_realized_face (face);
7484 return Qnil;
7488 DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
7489 0, 0, 0, doc: /* */)
7492 fprintf (stderr, "number of colors = %d\n", ncolors_allocated);
7493 fprintf (stderr, "number of pixmaps = %d\n", npixmaps_allocated);
7494 fprintf (stderr, "number of GCs = %d\n", ngcs);
7495 return Qnil;
7498 #endif /* GLYPH_DEBUG != 0 */
7502 /***********************************************************************
7503 Initialization
7504 ***********************************************************************/
7506 void
7507 syms_of_xfaces ()
7509 Qface = intern ("face");
7510 staticpro (&Qface);
7511 Qbitmap_spec_p = intern ("bitmap-spec-p");
7512 staticpro (&Qbitmap_spec_p);
7513 Qframe_update_face_colors = intern ("frame-update-face-colors");
7514 staticpro (&Qframe_update_face_colors);
7516 /* Lisp face attribute keywords. */
7517 QCfamily = intern (":family");
7518 staticpro (&QCfamily);
7519 QCheight = intern (":height");
7520 staticpro (&QCheight);
7521 QCweight = intern (":weight");
7522 staticpro (&QCweight);
7523 QCslant = intern (":slant");
7524 staticpro (&QCslant);
7525 QCunderline = intern (":underline");
7526 staticpro (&QCunderline);
7527 QCinverse_video = intern (":inverse-video");
7528 staticpro (&QCinverse_video);
7529 QCreverse_video = intern (":reverse-video");
7530 staticpro (&QCreverse_video);
7531 QCforeground = intern (":foreground");
7532 staticpro (&QCforeground);
7533 QCbackground = intern (":background");
7534 staticpro (&QCbackground);
7535 QCstipple = intern (":stipple");;
7536 staticpro (&QCstipple);
7537 QCwidth = intern (":width");
7538 staticpro (&QCwidth);
7539 QCfont = intern (":font");
7540 staticpro (&QCfont);
7541 QCbold = intern (":bold");
7542 staticpro (&QCbold);
7543 QCitalic = intern (":italic");
7544 staticpro (&QCitalic);
7545 QCoverline = intern (":overline");
7546 staticpro (&QCoverline);
7547 QCstrike_through = intern (":strike-through");
7548 staticpro (&QCstrike_through);
7549 QCbox = intern (":box");
7550 staticpro (&QCbox);
7551 QCinherit = intern (":inherit");
7552 staticpro (&QCinherit);
7554 /* Symbols used for Lisp face attribute values. */
7555 QCcolor = intern (":color");
7556 staticpro (&QCcolor);
7557 QCline_width = intern (":line-width");
7558 staticpro (&QCline_width);
7559 QCstyle = intern (":style");
7560 staticpro (&QCstyle);
7561 Qreleased_button = intern ("released-button");
7562 staticpro (&Qreleased_button);
7563 Qpressed_button = intern ("pressed-button");
7564 staticpro (&Qpressed_button);
7565 Qnormal = intern ("normal");
7566 staticpro (&Qnormal);
7567 Qultra_light = intern ("ultra-light");
7568 staticpro (&Qultra_light);
7569 Qextra_light = intern ("extra-light");
7570 staticpro (&Qextra_light);
7571 Qlight = intern ("light");
7572 staticpro (&Qlight);
7573 Qsemi_light = intern ("semi-light");
7574 staticpro (&Qsemi_light);
7575 Qsemi_bold = intern ("semi-bold");
7576 staticpro (&Qsemi_bold);
7577 Qbold = intern ("bold");
7578 staticpro (&Qbold);
7579 Qextra_bold = intern ("extra-bold");
7580 staticpro (&Qextra_bold);
7581 Qultra_bold = intern ("ultra-bold");
7582 staticpro (&Qultra_bold);
7583 Qoblique = intern ("oblique");
7584 staticpro (&Qoblique);
7585 Qitalic = intern ("italic");
7586 staticpro (&Qitalic);
7587 Qreverse_oblique = intern ("reverse-oblique");
7588 staticpro (&Qreverse_oblique);
7589 Qreverse_italic = intern ("reverse-italic");
7590 staticpro (&Qreverse_italic);
7591 Qultra_condensed = intern ("ultra-condensed");
7592 staticpro (&Qultra_condensed);
7593 Qextra_condensed = intern ("extra-condensed");
7594 staticpro (&Qextra_condensed);
7595 Qcondensed = intern ("condensed");
7596 staticpro (&Qcondensed);
7597 Qsemi_condensed = intern ("semi-condensed");
7598 staticpro (&Qsemi_condensed);
7599 Qsemi_expanded = intern ("semi-expanded");
7600 staticpro (&Qsemi_expanded);
7601 Qexpanded = intern ("expanded");
7602 staticpro (&Qexpanded);
7603 Qextra_expanded = intern ("extra-expanded");
7604 staticpro (&Qextra_expanded);
7605 Qultra_expanded = intern ("ultra-expanded");
7606 staticpro (&Qultra_expanded);
7607 Qbackground_color = intern ("background-color");
7608 staticpro (&Qbackground_color);
7609 Qforeground_color = intern ("foreground-color");
7610 staticpro (&Qforeground_color);
7611 Qunspecified = intern ("unspecified");
7612 staticpro (&Qunspecified);
7614 Qface_alias = intern ("face-alias");
7615 staticpro (&Qface_alias);
7616 Qdefault = intern ("default");
7617 staticpro (&Qdefault);
7618 Qtool_bar = intern ("tool-bar");
7619 staticpro (&Qtool_bar);
7620 Qregion = intern ("region");
7621 staticpro (&Qregion);
7622 Qfringe = intern ("fringe");
7623 staticpro (&Qfringe);
7624 Qheader_line = intern ("header-line");
7625 staticpro (&Qheader_line);
7626 Qscroll_bar = intern ("scroll-bar");
7627 staticpro (&Qscroll_bar);
7628 Qmenu = intern ("menu");
7629 staticpro (&Qmenu);
7630 Qcursor = intern ("cursor");
7631 staticpro (&Qcursor);
7632 Qborder = intern ("border");
7633 staticpro (&Qborder);
7634 Qmouse = intern ("mouse");
7635 staticpro (&Qmouse);
7636 Qmode_line_inactive = intern ("mode-line-inactive");
7637 staticpro (&Qmode_line_inactive);
7638 Qtty_color_desc = intern ("tty-color-desc");
7639 staticpro (&Qtty_color_desc);
7640 Qtty_color_standard_values = intern ("tty-color-standard-values");
7641 staticpro (&Qtty_color_standard_values);
7642 Qtty_color_by_index = intern ("tty-color-by-index");
7643 staticpro (&Qtty_color_by_index);
7644 Qtty_color_alist = intern ("tty-color-alist");
7645 staticpro (&Qtty_color_alist);
7646 Qscalable_fonts_allowed = intern ("scalable-fonts-allowed");
7647 staticpro (&Qscalable_fonts_allowed);
7649 Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil);
7650 staticpro (&Vparam_value_alist);
7651 Vface_alternative_font_family_alist = Qnil;
7652 staticpro (&Vface_alternative_font_family_alist);
7653 Vface_alternative_font_registry_alist = Qnil;
7654 staticpro (&Vface_alternative_font_registry_alist);
7656 defsubr (&Sinternal_make_lisp_face);
7657 defsubr (&Sinternal_lisp_face_p);
7658 defsubr (&Sinternal_set_lisp_face_attribute);
7659 #ifdef HAVE_WINDOW_SYSTEM
7660 defsubr (&Sinternal_set_lisp_face_attribute_from_resource);
7661 #endif
7662 defsubr (&Scolor_gray_p);
7663 defsubr (&Scolor_supported_p);
7664 defsubr (&Sface_attribute_relative_p);
7665 defsubr (&Smerge_face_attribute);
7666 defsubr (&Sinternal_get_lisp_face_attribute);
7667 defsubr (&Sinternal_lisp_face_attribute_values);
7668 defsubr (&Sinternal_lisp_face_equal_p);
7669 defsubr (&Sinternal_lisp_face_empty_p);
7670 defsubr (&Sinternal_copy_lisp_face);
7671 defsubr (&Sinternal_merge_in_global_face);
7672 defsubr (&Sface_font);
7673 defsubr (&Sframe_face_alist);
7674 defsubr (&Stty_supports_face_attributes_p);
7675 defsubr (&Scolor_distance);
7676 defsubr (&Sinternal_set_font_selection_order);
7677 defsubr (&Sinternal_set_alternative_font_family_alist);
7678 defsubr (&Sinternal_set_alternative_font_registry_alist);
7679 defsubr (&Sface_attributes_as_vector);
7680 #if GLYPH_DEBUG
7681 defsubr (&Sdump_face);
7682 defsubr (&Sshow_face_resources);
7683 #endif /* GLYPH_DEBUG */
7684 defsubr (&Sclear_face_cache);
7685 defsubr (&Stty_suppress_bold_inverse_default_colors);
7687 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7688 defsubr (&Sdump_colors);
7689 #endif
7691 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit,
7692 doc: /* *Limit for font matching.
7693 If an integer > 0, font matching functions won't load more than
7694 that number of fonts when searching for a matching font. */);
7695 Vfont_list_limit = make_number (DEFAULT_FONT_LIST_LIMIT);
7697 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults,
7698 doc: /* List of global face definitions (for internal use only.) */);
7699 Vface_new_frame_defaults = Qnil;
7701 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple,
7702 doc: /* *Default stipple pattern used on monochrome displays.
7703 This stipple pattern is used on monochrome displays
7704 instead of shades of gray for a face background color.
7705 See `set-face-stipple' for possible values for this variable. */);
7706 Vface_default_stipple = build_string ("gray3");
7708 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist,
7709 doc: /* An alist of defined terminal colors and their RGB values. */);
7710 Vtty_defined_color_alist = Qnil;
7712 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed,
7713 doc: /* Allowed scalable fonts.
7714 A value of nil means don't allow any scalable fonts.
7715 A value of t means allow any scalable font.
7716 Otherwise, value must be a list of regular expressions. A font may be
7717 scaled if its name matches a regular expression in the list.
7718 Note that if value is nil, a scalable font might still be used, if no
7719 other font of the appropriate family and registry is available. */);
7720 Vscalable_fonts_allowed = Qnil;
7722 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts,
7723 doc: /* List of ignored fonts.
7724 Each element is a regular expression that matches names of fonts to
7725 ignore. */);
7726 Vface_ignored_fonts = Qnil;
7728 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist,
7729 doc: /* Alist of fonts vs the rescaling factors.
7730 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7731 FONT-NAME-PATTERN is a regular expression matching a font name, and
7732 RESCALE-RATIO is a floating point number to specify how much larger
7733 \(or smaller) font we should use. For instance, if a face requests
7734 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7735 Vface_font_rescale_alist = Qnil;
7737 #ifdef HAVE_WINDOW_SYSTEM
7738 defsubr (&Sbitmap_spec_p);
7739 defsubr (&Sx_list_fonts);
7740 defsubr (&Sinternal_face_x_get_resource);
7741 defsubr (&Sx_family_fonts);
7742 defsubr (&Sx_font_family_list);
7743 #endif /* HAVE_WINDOW_SYSTEM */
7746 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
7747 (do not change this comment) */