src/xfaces.c

/* [<][>][^][v][top][bottom][index][help] */
This source file includes following definitions.
register_color
unregister_color
unregister_colors
DEFUN
x_free_colors
x_free_dpy_colors
x_create_gc
x_free_gc
x_create_gc
x_free_gc
x_create_gc
x_free_gc
x_create_gc
x_free_gc
init_frame_faces
free_frame_faces
recompute_basic_faces
clear_face_cache
DEFUN
DEFUN
load_pixmap
parse_hex_color_comp
parse_float_color_comp
parse_color_spec
DEFUN
parse_rgb_list
tty_lookup_color
tty_defined_color
tty_color_name
face_color_gray_p
face_color_supported_p
load_color2
load_color
load_face_colors
unload_color
free_face_colors
compare_fonts_by_sort_order
check_lface_attrs
check_lface
push_named_merge_point
resolve_face_name
lface_from_face_name_no_resolve
lface_from_face_name
get_lface_attributes_no_remap
get_lface_attributes
lface_fully_specified_p
set_lface_from_font
merge_face_heights
merge_face_vectors
face_inherited_attr
merge_named_face
evaluate_face_filter
filter_face_ref
merge_face_ref
update_face_from_frame_parameter
set_font_frame_param
face_boolean_x_resource_value
x_update_menu_appearance
DEFUN
face_attr_equal_p
lface_equal_p
DEFUN
hash_string_case_insensitive
lface_hash
lface_same_font_attributes_p
make_realized_face
free_realized_face
prepare_face_for_display
color_distance
make_face_cache
clear_face_gcs
free_realized_faces
free_all_realized_faces
free_face_cache
cache_face
uncache_face
lookup_face
face_for_font
lookup_named_face
lookup_basic_face
smaller_face
face_with_height
lookup_derived_face
DEFUN
gui_supports_face_attributes_p
tty_supports_face_attributes_p
DEFUN
DEFUN
DEFUN
face_fontset
realize_basic_faces
realize_default_face
realize_named_face
realize_face
realize_non_ascii_face
font_maybe_unset_attribute
realize_gui_face
map_tty_color
realize_tty_face
DEFUN
compute_char_face
face_at_buffer_position
face_for_overlay_string
face_at_string_position
merge_faces
DEFUN
dump_realized_face
DEFUN
DEFUN
init_xfaces
syms_of_xfaces
     1 /* xfaces.c -- "Face" primitives.
     2 
     3 Copyright (C) 1993-1994, 1998-2023 Free Software Foundation, Inc.
     4 
     5 This file is part of GNU Emacs.
     6 
     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 3 of the License, or (at
    10 your option) any later version.
    11 
    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.
    16 
    17 You should have received a copy of the GNU General Public License
    18 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    19 
    20 /* New face implementation by Gerd Moellmann <gerd@gnu.org>.  */
    21 
    22 /* Faces.
    23 
    24    When using Emacs with X, the display style of characters can be
    25    changed by defining `faces'.  Each face can specify the following
    26    display attributes:
    27 
    28    1. Font family name.
    29 
    30    2. Font foundry name.
    31 
    32    3. Relative proportionate width, aka character set width or set
    33    width (swidth), e.g. `semi-compressed'.
    34 
    35    4. Font height in 1/10pt.
    36 
    37    5. Font weight, e.g. `bold'.
    38 
    39    6. Font slant, e.g. `italic'.
    40 
    41    7. Foreground color.
    42 
    43    8. Background color.
    44 
    45    9. Whether or not characters should be underlined, and in what color.
    46 
    47    10. Whether or not characters should be displayed in inverse video.
    48 
    49    11. A background stipple, a bitmap.
    50 
    51    12. Whether or not characters should be overlined, and in what color.
    52 
    53    13. Whether or not characters should be strike-through, and in what
    54    color.
    55 
    56    14. Whether or not a box should be drawn around characters, the box
    57    type, and, for simple boxes, in what color.
    58 
    59    15. Font-spec, or nil.  This is a special attribute.
    60 
    61    A font-spec is a collection of font attributes (specs).
    62 
    63    When this attribute is specified, the face uses a font matching
    64    with the specs as is except for what overwritten by the specs in
    65    the fontset (see below).  In addition, the other font-related
    66    attributes (1st thru 5th) are updated from the spec.
    67 
    68    On the other hand, if one of the other font-related attributes are
    69    specified, the corresponding specs in this attribute is set to nil.
    70 
    71    16. A face name or list of face names from which to inherit attributes.
    72 
    73    17. A fontset name.  This is another special attribute.
    74 
    75    A fontset is a mappings from characters to font-specs, and the
    76    specs overwrite the font-spec in the 14th attribute.
    77 
    78    18. A "distant background" color, to be used when the foreground is
    79    too close to the background and is hard to read.
    80 
    81    19. Whether to extend the face to end of line when the face
    82    "covers" the newline that ends the line.
    83 
    84    On the C level, a Lisp face is completely represented by its array
    85    of attributes.  In that array, the zeroth element is Qface, and the
    86    rest are the 19 face attributes described above.  The
    87    lface_attribute_index enumeration, defined on dispextern.h, with
    88    values given by the LFACE_*_INDEX constants, is used to reference
    89    the individual attributes.
    90 
    91    Faces are frame-local by nature because Emacs allows you to define the
    92    same named face (face names are symbols) differently for different
    93    frames.  Each frame has an alist of face definitions for all named
    94    faces.  The value of a named face in such an alist is a Lisp vector
    95    with the symbol `face' in slot 0, and a slot for each of the face
    96    attributes mentioned above.
    97 
    98    There is also a global face map `Vface_new_frame_defaults',
    99    containing conses of (FACE_ID . FACE_DEFINITION).  Face definitions
   100    from this table are used to initialize faces of newly created
   101    frames.
   102 
   103    A face doesn't have to specify all attributes.  Those not specified
   104    have a value of `unspecified'.  Faces specifying all attributes but
   105    the 14th are called `fully-specified'.
   106 
   107 
   108    Face merging.
   109 
   110    The display style of a given character in the text is determined by
   111    combining several faces.  This process is called `face merging'.
   112    Face merging combines the attributes of each of the faces being
   113    merged such that the attributes of the face that is merged later
   114    override those of a face merged earlier in the process.  In
   115    particular, this replaces any 'unspecified' attributes with
   116    non-'unspecified' values.  Also, if a face inherits from another
   117    (via the :inherit attribute), the attributes of the parent face,
   118    recursively, are applied where the inheriting face doesn't specify
   119    non-'unspecified' values.  Any aspect of the display style that
   120    isn't specified by overlays or text properties is taken from the
   121    'default' face.  Since it is made sure that the default face is
   122    always fully-specified, face merging always results in a
   123    fully-specified face.
   124 
   125 
   126    Face realization.
   127 
   128    After all face attributes for a character have been determined by
   129    merging faces of that character, that face is `realized'.  The
   130    realization process maps face attributes to what is physically
   131    available on the system where Emacs runs.  The result is a
   132    `realized face' in the form of a struct face which is stored in the
   133    face cache of the frame on which it was realized.
   134 
   135    Face realization is done in the context of the character to display
   136    because different fonts may be used for different characters.  In
   137    other words, for characters that have different font
   138    specifications, different realized faces are needed to display
   139    them.
   140 
   141    Font specification is done by fontsets.  See the comment in
   142    fontset.c for the details.  In the current implementation, all ASCII
   143    characters share the same font in a fontset.
   144 
   145    Faces are at first realized for ASCII characters, and, at that
   146    time, assigned a specific realized fontset.  Hereafter, we call
   147    such a face as `ASCII face'.  When a face for a multibyte character
   148    is realized, it inherits (thus shares) a fontset of an ASCII face
   149    that has the same attributes other than font-related ones.
   150 
   151    Thus, all realized faces have a realized fontset.
   152 
   153 
   154    Unibyte text.
   155 
   156    Unibyte text (i.e. raw 8-bit characters) is displayed with the same
   157    font as ASCII characters.  That is because it is expected that
   158    unibyte text users specify a font that is suitable both for ASCII
   159    and raw 8-bit characters.
   160 
   161 
   162    Font selection.
   163 
   164    Font selection tries to find the best available matching font for a
   165    given (character, face) combination.
   166 
   167    If the face specifies a fontset name, that fontset determines a
   168    pattern for fonts of the given character.  If the face specifies a
   169    font name or the other font-related attributes, a fontset is
   170    realized from the default fontset.  In that case, that
   171    specification determines a pattern for ASCII characters and the
   172    default fontset determines a pattern for multibyte characters.
   173 
   174    Available fonts on the system on which Emacs runs are then matched
   175    against the font pattern.  The result of font selection is the best
   176    match for the given face attributes in this font list.
   177 
   178    Font selection can be influenced by the user.
   179 
   180    1. The user can specify the relative importance he gives the face
   181    attributes width, height, weight, and slant by setting
   182    face-font-selection-order (faces.el) to a list of face attribute
   183    names.  The default is '(:width :height :weight :slant), and means
   184    that font selection first tries to find a good match for the font
   185    width specified by a face, then---within fonts with that
   186    width---tries to find a best match for the specified font height,
   187    etc.
   188 
   189    2. Setting face-font-family-alternatives allows the user to
   190    specify alternative font families to try if a family specified by a
   191    face doesn't exist.
   192 
   193    3. Setting face-font-registry-alternatives allows the user to
   194    specify all alternative font registries to try for a face
   195    specifying a registry.
   196 
   197    4. Setting face-ignored-fonts allows the user to ignore specific
   198    fonts.
   199 
   200 
   201    Character composition.
   202 
   203    Usually, the realization process is already finished when Emacs
   204    actually reflects the desired glyph matrix on the screen.  However,
   205    on displaying a composition (sequence of characters to be composed
   206    on the screen), a suitable font for the components of the
   207    composition is selected and realized while drawing them on the
   208    screen, i.e.  the realization process is delayed but in principle
   209    the same.
   210 
   211 
   212    Initialization of basic faces.
   213 
   214    The faces `default', `modeline' are considered `basic faces'.
   215    When redisplay happens the first time for a newly created frame,
   216    basic faces are realized for CHARSET_ASCII.  Frame parameters are
   217    used to fill in unspecified attributes of the default face.  */
   218 
   219 #include <config.h>
   220 #include <stdlib.h>
   221 #include "sysstdio.h"
   222 #include <sys/types.h>
   223 #include <sys/stat.h>
   224 #include <math.h>
   225 
   226 #include "lisp.h"
   227 #include "character.h"
   228 #include "frame.h"
   229 
   230 #ifdef USE_MOTIF
   231 #include <Xm/Xm.h>
   232 #include <Xm/XmStrDefs.h>
   233 #endif /* USE_MOTIF */
   234 
   235 #ifdef MSDOS
   236 #include "dosfns.h"
   237 #endif
   238 
   239 #ifdef HAVE_WINDOW_SYSTEM
   240 #include TERM_HEADER
   241 #include "fontset.h"
   242 #ifdef HAVE_NTGUI
   243 #define GCGraphicsExposures 0
   244 #endif /* HAVE_NTGUI */
   245 
   246 #ifdef HAVE_NS
   247 #define GCGraphicsExposures 0
   248 #endif /* HAVE_NS */
   249 
   250 #ifdef HAVE_PGTK
   251 #define GCGraphicsExposures 0
   252 #endif /* HAVE_PGTK */
   253 
   254 #ifdef HAVE_HAIKU
   255 #define GCGraphicsExposures 0
   256 #endif /* HAVE_HAIKU */
   257 #endif /* HAVE_WINDOW_SYSTEM */
   258 
   259 #include "buffer.h"
   260 #include "dispextern.h"
   261 #include "blockinput.h"
   262 #include "window.h"
   263 #include "termchar.h"
   264 
   265 #include "font.h"
   266 
   267 #ifdef HAVE_X_WINDOWS
   268 
   269 /* Compensate for a bug in Xos.h on some systems, on which it requires
   270    time.h.  On some such systems, Xos.h tries to redefine struct
   271    timeval and struct timezone if USG is #defined while it is
   272    #included.  */
   273 
   274 #ifdef XOS_NEEDS_TIME_H
   275 #include <time.h>
   276 #undef USG
   277 #include <X11/Xos.h>
   278 #define USG
   279 #define __TIMEVAL__
   280 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros.  */
   281 #endif
   282 #else /* not XOS_NEEDS_TIME_H */
   283 #include <X11/Xos.h>
   284 #endif /* not XOS_NEEDS_TIME_H */
   285 
   286 #endif /* HAVE_X_WINDOWS */
   287 
   288 #include <c-ctype.h>
   289 
   290 /* True if face attribute ATTR is unspecified.  */
   291 
   292 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
   293 
   294 /* True if face attribute ATTR is `ignore-defface'.  */
   295 
   296 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
   297 
   298 /* True if face attribute ATTR is `reset'.  */
   299 
   300 #define RESET_P(ATTR) EQ ((ATTR), Qreset)
   301 
   302 /* Size of hash table of realized faces in face caches (should be a
   303    prime number).  */
   304 
   305 #define FACE_CACHE_BUCKETS_SIZE 1009
   306 
   307 char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
   308 
   309 /* Alist of alternative font families.  Each element is of the form
   310    (FAMILY FAMILY1 FAMILY2 ...).  If fonts of FAMILY can't be loaded,
   311    try FAMILY1, then FAMILY2, ...  */
   312 
   313 Lisp_Object Vface_alternative_font_family_alist;
   314 
   315 /* Alist of alternative font registries.  Each element is of the form
   316    (REGISTRY REGISTRY1 REGISTRY2...).  If fonts of REGISTRY can't be
   317    loaded, try REGISTRY1, then REGISTRY2, ...  */
   318 
   319 Lisp_Object Vface_alternative_font_registry_alist;
   320 
   321 /* The next ID to assign to Lisp faces.  */
   322 
   323 static int next_lface_id;
   324 
   325 /* A vector mapping Lisp face Id's to face names.  */
   326 
   327 static Lisp_Object *lface_id_to_name;
   328 static ptrdiff_t lface_id_to_name_size;
   329 
   330 #ifdef HAVE_WINDOW_SYSTEM
   331 
   332 /* Counter for calls to clear_face_cache.  If this counter reaches
   333    CLEAR_FONT_TABLE_COUNT, and a frame has more than
   334    CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed.  */
   335 
   336 static int clear_font_table_count;
   337 #define CLEAR_FONT_TABLE_COUNT  100
   338 #define CLEAR_FONT_TABLE_NFONTS 10
   339 
   340 #endif /* HAVE_WINDOW_SYSTEM */
   341 
   342 /* True means face attributes have been changed since the last
   343    redisplay.  Used in redisplay_internal.  */
   344 
   345 bool face_change;
   346 
   347 /* True means don't display bold text if a face's foreground
   348    and background colors are the inverse of the default colors of the
   349    display.   This is a kluge to suppress `bold black' foreground text
   350    which is hard to read on an LCD monitor.  */
   351 
   352 static bool tty_suppress_bold_inverse_default_colors_p;
   353 
   354 /* The total number of colors currently allocated.  */
   355 
   356 #ifdef GLYPH_DEBUG
   357 static int ncolors_allocated;
   358 static int npixmaps_allocated;
   359 static int ngcs;
   360 #endif
   361 
   362 /* True means the definition of the `menu' face for new frames has
   363    been changed.  */
   364 
   365 static bool menu_face_changed_default;
   366 
   367 struct named_merge_point;
   368 
   369 static struct face *realize_face (struct face_cache *,
   370                                   Lisp_Object [LFACE_VECTOR_SIZE],
   371                                   int);
   372 static struct face *realize_gui_face (struct face_cache *,
   373                                       Lisp_Object [LFACE_VECTOR_SIZE]);
   374 static struct face *realize_tty_face (struct face_cache *,
   375                                       Lisp_Object [LFACE_VECTOR_SIZE]);
   376 static bool realize_basic_faces (struct frame *);
   377 static bool realize_default_face (struct frame *);
   378 static void realize_named_face (struct frame *, Lisp_Object, int);
   379 static struct face_cache *make_face_cache (struct frame *);
   380 static void free_face_cache (struct face_cache *);
   381 static bool merge_face_ref (struct window *w,
   382                             struct frame *, Lisp_Object, Lisp_Object *,
   383                             bool, struct named_merge_point *,
   384                             enum lface_attribute_index);
   385 static int color_distance (Emacs_Color *x, Emacs_Color *y);
   386 
   387 #ifdef HAVE_WINDOW_SYSTEM
   388 static void set_font_frame_param (Lisp_Object, Lisp_Object);
   389 static void clear_face_gcs (struct face_cache *);
   390 static struct face *realize_non_ascii_face (struct frame *, Lisp_Object,
   391                                             struct face *);
   392 #endif /* HAVE_WINDOW_SYSTEM */
   393 
   394 /***********************************************************************
   395                               Utilities
   396  ***********************************************************************/
   397 
   398 #ifdef HAVE_X_WINDOWS
   399 
   400 #ifdef DEBUG_X_COLORS
   401 
   402 /* The following is a poor mans infrastructure for debugging X color
   403    allocation problems on displays with PseudoColor-8.  Some X servers
   404    like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
   405    color reference counts completely so that they don't signal an
   406    error when a color is freed whose reference count is already 0.
   407    Other X servers do.  To help me debug this, the following code
   408    implements a simple reference counting schema of its own, for a
   409    single display/screen.  --gerd.  */
   410 
   411 /* Reference counts for pixel colors.  */
   412 
   413 int color_count[256];
   414 
   415 /* Register color PIXEL as allocated.  */
   416 
   417 void
   418 register_color (unsigned long pixel)
   419 {
   420   eassert (pixel < 256);
   421   ++color_count[pixel];
   422 }
   423 
   424 
   425 /* Register color PIXEL as deallocated.  */
   426 
   427 void
   428 unregister_color (unsigned long pixel)
   429 {
   430   eassert (pixel < 256);
   431   if (color_count[pixel] > 0)
   432     --color_count[pixel];
   433   else
   434     emacs_abort ();
   435 }
   436 
   437 
   438 /* Register N colors from PIXELS as deallocated.  */
   439 
   440 void
   441 unregister_colors (unsigned long *pixels, int n)
   442 {
   443   int i;
   444   for (i = 0; i < n; ++i)
   445     unregister_color (pixels[i]);
   446 }
   447 
   448 
   449 DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
   450        doc: /* Dump currently allocated colors to stderr.  */)
   451   (void)
   452 {
   453   int i, n;
   454 
   455   putc ('\n', stderr);
   456 
   457   for (i = n = 0; i < ARRAYELTS (color_count); ++i)
   458     if (color_count[i])
   459       {
   460         fprintf (stderr, "%3d: %5d", i, color_count[i]);
   461         ++n;
   462         putc (n % 5 == 0 ? '\n' : '\t', stderr);
   463       }
   464 
   465   if (n % 5 != 0)
   466     putc ('\n', stderr);
   467   return Qnil;
   468 }
   469 
   470 #endif /* DEBUG_X_COLORS */
   471 
   472 
   473 /* Free colors used on frame F.  PIXELS is an array of NPIXELS pixel
   474    color values.  Interrupt input must be blocked when this function
   475    is called.  */
   476 
   477 void
   478 x_free_colors (struct frame *f, unsigned long *pixels, int npixels)
   479 {
   480   /* If display has an immutable color map, freeing colors is not
   481      necessary and some servers don't allow it.  So don't do it.  */
   482   if (x_mutable_colormap (FRAME_X_VISUAL_INFO (f)))
   483     {
   484 #ifdef DEBUG_X_COLORS
   485       unregister_colors (pixels, npixels);
   486 #endif
   487       XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
   488                    pixels, npixels, 0);
   489     }
   490 }
   491 
   492 
   493 #ifdef USE_X_TOOLKIT
   494 
   495 /* Free colors used on display DPY.  PIXELS is an array of NPIXELS pixel
   496    color values.  Interrupt input must be blocked when this function
   497    is called.  */
   498 
   499 void
   500 x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap,
   501                    unsigned long *pixels, int npixels)
   502 {
   503   struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
   504 
   505   /* If display has an immutable color map, freeing colors is not
   506      necessary and some servers don't allow it.  So don't do it.  */
   507   if (x_mutable_colormap (&dpyinfo->visual_info))
   508     {
   509 #ifdef DEBUG_X_COLORS
   510       unregister_colors (pixels, npixels);
   511 #endif
   512       XFreeColors (dpy, cmap, pixels, npixels, 0);
   513     }
   514 }
   515 #endif /* USE_X_TOOLKIT */
   516 
   517 /* Create and return a GC for use on frame F.  GC values and mask
   518    are given by XGCV and MASK.  */
   519 
   520 static GC
   521 x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
   522 {
   523   GC gc;
   524   block_input ();
   525   gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), mask, xgcv);
   526   unblock_input ();
   527   IF_DEBUG (++ngcs);
   528   return gc;
   529 }
   530 
   531 
   532 /* Free GC which was used on frame F.  */
   533 
   534 static void
   535 x_free_gc (struct frame *f, GC gc)
   536 {
   537   eassert (input_blocked_p ());
   538   IF_DEBUG ((--ngcs, eassert (ngcs >= 0)));
   539   XFreeGC (FRAME_X_DISPLAY (f), gc);
   540 }
   541 
   542 #endif /* HAVE_X_WINDOWS */
   543 
   544 #ifdef HAVE_NTGUI
   545 /* W32 emulation of GCs */
   546 
   547 static Emacs_GC *
   548 x_create_gc (struct frame *f, unsigned long mask, Emacs_GC *egc)
   549 {
   550   Emacs_GC *gc;
   551   block_input ();
   552   gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, egc);
   553   unblock_input ();
   554   IF_DEBUG (++ngcs);
   555   return gc;
   556 }
   557 
   558 
   559 /* Free GC which was used on frame F.  */
   560 
   561 static void
   562 x_free_gc (struct frame *f, Emacs_GC *gc)
   563 {
   564   IF_DEBUG ((--ngcs, eassert (ngcs >= 0)));
   565   xfree (gc);
   566 }
   567 
   568 #endif  /* HAVE_NTGUI */
   569 
   570 #if defined (HAVE_NS) || defined (HAVE_HAIKU)
   571 /* NS and Haiku emulation of GCs */
   572 
   573 static Emacs_GC *
   574 x_create_gc (struct frame *f,
   575              unsigned long mask,
   576              Emacs_GC *egc)
   577 {
   578   Emacs_GC *gc = xmalloc (sizeof *gc);
   579   *gc = *egc;
   580   return gc;
   581 }
   582 
   583 static void
   584 x_free_gc (struct frame *f, Emacs_GC *gc)
   585 {
   586   xfree (gc);
   587 }
   588 #endif  /* HAVE_NS */
   589 
   590 #ifdef HAVE_PGTK
   591 /* PGTK emulation of GCs */
   592 
   593 static Emacs_GC *
   594 x_create_gc (struct frame *f,
   595              unsigned long mask,
   596              Emacs_GC *xgcv)
   597 {
   598   Emacs_GC *gc = xmalloc (sizeof *gc);
   599   *gc = *xgcv;
   600   return gc;
   601 }
   602 
   603 static void
   604 x_free_gc (struct frame *f, Emacs_GC *gc)
   605 {
   606   xfree (gc);
   607 }
   608 #endif  /* HAVE_NS */
   609 
   610 /***********************************************************************
   611                            Frames and faces
   612  ***********************************************************************/
   613 
   614 /* Initialize face cache and basic faces for frame F.  */
   615 
   616 void
   617 init_frame_faces (struct frame *f)
   618 {
   619   /* Make a face cache, if F doesn't have one.  */
   620   if (FRAME_FACE_CACHE (f) == NULL)
   621     FRAME_FACE_CACHE (f) = make_face_cache (f);
   622 
   623 #ifdef HAVE_WINDOW_SYSTEM
   624   /* Make the image cache.  */
   625   if (FRAME_WINDOW_P (f))
   626     {
   627       /* We initialize the image cache when creating the first frame
   628          on a terminal, and not during terminal creation.  This way,
   629          `x-open-connection' on a tty won't create an image cache.  */
   630       if (FRAME_IMAGE_CACHE (f) == NULL)
   631         FRAME_IMAGE_CACHE (f) = make_image_cache ();
   632       ++FRAME_IMAGE_CACHE (f)->refcount;
   633     }
   634 #endif /* HAVE_WINDOW_SYSTEM */
   635 
   636   /* Realize faces early (Bug#17889).  */
   637   if (!realize_basic_faces (f))
   638     emacs_abort ();
   639 }
   640 
   641 
   642 /* Free face cache of frame F.  Called from frame-dependent
   643    resource freeing function, e.g. (x|tty)_free_frame_resources.  */
   644 
   645 void
   646 free_frame_faces (struct frame *f)
   647 {
   648   struct face_cache *face_cache = FRAME_FACE_CACHE (f);
   649 
   650   if (face_cache)
   651     {
   652       free_face_cache (face_cache);
   653       FRAME_FACE_CACHE (f) = NULL;
   654     }
   655 
   656 #ifdef HAVE_WINDOW_SYSTEM
   657   if (FRAME_WINDOW_P (f))
   658     {
   659       struct image_cache *image_cache = FRAME_IMAGE_CACHE (f);
   660       if (image_cache)
   661         {
   662           --image_cache->refcount;
   663           if (image_cache->refcount == 0)
   664             free_image_cache (f);
   665         }
   666     }
   667 #endif /* HAVE_WINDOW_SYSTEM */
   668 }
   669 
   670 
   671 /* Clear face caches, and recompute basic faces for frame F.  Call
   672    this after changing frame parameters on which those faces depend,
   673    or when realized faces have been freed due to changing attributes
   674    of named faces.  */
   675 
   676 void
   677 recompute_basic_faces (struct frame *f)
   678 {
   679   if (FRAME_FACE_CACHE (f))
   680     {
   681       clear_face_cache (false);
   682       if (!realize_basic_faces (f))
   683         emacs_abort ();
   684     }
   685 }
   686 
   687 
   688 /* Clear the face caches of all frames.  CLEAR_FONTS_P means
   689    try to free unused fonts, too.  */
   690 
   691 void
   692 clear_face_cache (bool clear_fonts_p)
   693 {
   694 #ifdef HAVE_WINDOW_SYSTEM
   695   Lisp_Object tail, frame;
   696 
   697   if (clear_fonts_p
   698       || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
   699     {
   700       /* From time to time see if we can unload some fonts.  This also
   701          frees all realized faces on all frames.  Fonts needed by
   702          faces will be loaded again when faces are realized again.  */
   703       clear_font_table_count = 0;
   704 
   705       FOR_EACH_FRAME (tail, frame)
   706         {
   707           struct frame *f = XFRAME (frame);
   708           if (FRAME_WINDOW_P (f)
   709               && FRAME_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS
   710               && !f->inhibit_clear_image_cache)
   711             {
   712               clear_font_cache (f);
   713               free_all_realized_faces (frame);
   714             }
   715         }
   716     }
   717   else
   718     {
   719       /* Clear GCs of realized faces.  */
   720       FOR_EACH_FRAME (tail, frame)
   721         {
   722           struct frame *f = XFRAME (frame);
   723           if (FRAME_WINDOW_P (f))
   724               clear_face_gcs (FRAME_FACE_CACHE (f));
   725         }
   726       clear_image_caches (Qnil);
   727     }
   728 #endif /* HAVE_WINDOW_SYSTEM */
   729 }
   730 
   731 DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
   732        doc: /* Clear face caches on all frames.
   733 Optional THOROUGHLY non-nil means try to free unused fonts, too.  */)
   734   (Lisp_Object thoroughly)
   735 {
   736   clear_face_cache (!NILP (thoroughly));
   737   face_change = true;
   738   windows_or_buffers_changed = 53;
   739   return Qnil;
   740 }
   741 
   742 
   743 /***********************************************************************
   744                               X Pixmaps
   745  ***********************************************************************/
   746 
   747 #ifdef HAVE_WINDOW_SYSTEM
   748 
   749 DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
   750        doc: /* Value is non-nil if OBJECT is a valid bitmap specification.
   751 A bitmap specification is either a string, a file name, or a list
   752 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
   753 HEIGHT is its height, and DATA is a string containing the bits of
   754 the pixmap.  Bits are stored row by row, each row occupies
   755 \(WIDTH + 7)/8 bytes.  */)
   756   (Lisp_Object object)
   757 {
   758   bool pixmap_p = false;
   759 
   760   if (STRINGP (object))
   761     /* If OBJECT is a string, it's a file name.  */
   762     pixmap_p = true;
   763   else if (CONSP (object))
   764     {
   765       /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
   766          HEIGHT must be ints > 0, and DATA must be string large
   767          enough to hold a bitmap of the specified size.  */
   768       Lisp_Object width, height, data;
   769 
   770       height = width = data = Qnil;
   771 
   772       if (CONSP (object))
   773         {
   774           width = XCAR (object);
   775           object = XCDR (object);
   776           if (CONSP (object))
   777             {
   778               height = XCAR (object);
   779               object = XCDR (object);
   780               if (CONSP (object))
   781                 data = XCAR (object);
   782             }
   783         }
   784 
   785       if (STRINGP (data)
   786           && RANGED_FIXNUMP (1, width, INT_MAX)
   787           && RANGED_FIXNUMP (1, height, INT_MAX))
   788         {
   789           int bytes_per_row = (XFIXNUM (width) + CHAR_BIT - 1) / CHAR_BIT;
   790           if (XFIXNUM (height) <= SBYTES (data) / bytes_per_row)
   791             pixmap_p = true;
   792         }
   793     }
   794 
   795   return pixmap_p ? Qt : Qnil;
   796 }
   797 
   798 
   799 /* Load a bitmap according to NAME (which is either a file name or a
   800    pixmap spec) for use on frame F.  Value is the bitmap_id (see
   801    xfns.c).  If NAME is nil, return with a bitmap id of zero.  If
   802    bitmap cannot be loaded, display a message saying so, and return
   803    zero.  */
   804 
   805 static ptrdiff_t
   806 load_pixmap (struct frame *f, Lisp_Object name)
   807 {
   808   ptrdiff_t bitmap_id;
   809 
   810   if (NILP (name))
   811     return 0;
   812 
   813   CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name);
   814 
   815   block_input ();
   816   if (CONSP (name))
   817     {
   818       /* Decode a bitmap spec into a bitmap.  */
   819 
   820       int h, w;
   821       Lisp_Object bits;
   822 
   823       w = XFIXNUM (Fcar (name));
   824       h = XFIXNUM (Fcar (Fcdr (name)));
   825       bits = Fcar (Fcdr (Fcdr (name)));
   826 
   827       bitmap_id = image_create_bitmap_from_data (f, SSDATA (bits),
   828                                                  w, h);
   829     }
   830   else
   831     {
   832       /* It must be a string -- a file name.  */
   833       bitmap_id = image_create_bitmap_from_file (f, name);
   834     }
   835   unblock_input ();
   836 
   837   if (bitmap_id < 0)
   838     {
   839       add_to_log ("Invalid or undefined bitmap `%s'", name);
   840       bitmap_id = 0;
   841     }
   842   else
   843     {
   844 #ifdef GLYPH_DEBUG
   845       ++npixmaps_allocated;
   846 #endif
   847     }
   848 
   849   return bitmap_id;
   850 }
   851 
   852 #endif /* HAVE_WINDOW_SYSTEM */
   853 
   854 
   855 
   856 /***********************************************************************
   857                             Color Handling
   858  ***********************************************************************/
   859 
   860 /* Parse hex color component specification that starts at S and ends
   861    right before E.  Set *DST to the parsed value normalized so that
   862    the maximum value for the number of hex digits given becomes 65535,
   863    and return true on success, false otherwise.  */
   864 static bool
   865 parse_hex_color_comp (const char *s, const char *e, unsigned short *dst)
   866 {
   867   int n = e - s;
   868   if (n <= 0 || n > 4)
   869     return false;
   870   int val = 0;
   871   for (; s < e; s++)
   872     {
   873       int digit;
   874       if (*s >= '0' && *s <= '9')
   875         digit = *s - '0';
   876       else if (*s >= 'A' && *s <= 'F')
   877         digit = *s - 'A' + 10;
   878       else if (*s >= 'a' && *s <= 'f')
   879         digit = *s - 'a' + 10;
   880       else
   881         return false;
   882       val = (val << 4) | digit;
   883     }
   884   int maxval = (1 << (n * 4)) - 1;
   885   *dst = (unsigned)val * 65535 / maxval;
   886   return true;
   887 }
   888 
   889 /* Parse floating-point color component specification that starts at S
   890    and ends right before E.  Return the parsed number if in the range
   891    [0,1]; otherwise return -1.  */
   892 static double
   893 parse_float_color_comp (const char *s, const char *e)
   894 {
   895   /* Only allow decimal float literals without whitespace.  */
   896   for (const char *p = s; p < e; p++)
   897     if (!((*p >= '0' && *p <= '9')
   898           || *p == '.' || *p == '+' || *p == '-' || *p == 'e' || *p == 'E'))
   899       return -1;
   900   char *end;
   901   double x = strtod (s, &end);
   902   return (end == e && x >= 0 && x <= 1) ? x : -1;
   903 }
   904 
   905 /* Parse SPEC as a numeric color specification and set *R, *G and *B.
   906    Return true on success, false on failure.
   907 
   908    Recognized formats of SPEC:
   909 
   910     "#RGB", with R, G and B hex strings of equal length, 1-4 digits each.
   911     "rgb:R/G/B", with R, G and B hex strings, 1-4 digits each.
   912     "rgbi:R/G/B", with R, G and B numbers in [0,1].
   913 
   914    If the function succeeds, it assigns to each of the components *R,
   915    *G, and *B a value normalized to be in the [0, 65535] range.  If
   916    the function fails, some or all of the components remain unassigned.  */
   917 bool
   918 parse_color_spec (const char *spec,
   919                   unsigned short *r, unsigned short *g, unsigned short *b)
   920 {
   921   int len = strlen (spec);
   922   if (spec[0] == '#')
   923     {
   924       if ((len - 1) % 3 == 0)
   925         {
   926           int n = (len - 1) / 3;
   927           return (   parse_hex_color_comp (spec + 1 + 0 * n,
   928                                            spec + 1 + 1 * n, r)
   929                   && parse_hex_color_comp (spec + 1 + 1 * n,
   930                                            spec + 1 + 2 * n, g)
   931                   && parse_hex_color_comp (spec + 1 + 2 * n,
   932                                            spec + 1 + 3 * n, b));
   933         }
   934     }
   935   else if (strncmp (spec, "rgb:", 4) == 0)
   936     {
   937       char *sep1, *sep2;
   938       return ((sep1 = strchr (spec + 4, '/')) != NULL
   939               && (sep2 = strchr (sep1 + 1, '/')) != NULL
   940               && parse_hex_color_comp (spec + 4, sep1, r)
   941               && parse_hex_color_comp (sep1 + 1, sep2, g)
   942               && parse_hex_color_comp (sep2 + 1, spec + len, b));
   943     }
   944   else if (strncmp (spec, "rgbi:", 5) == 0)
   945     {
   946       char *sep1, *sep2;
   947       double red, green, blue;
   948       if ((sep1 = strchr (spec + 5, '/')) != NULL
   949           && (sep2 = strchr (sep1 + 1, '/')) != NULL
   950           && (red = parse_float_color_comp (spec + 5, sep1)) >= 0
   951           && (green = parse_float_color_comp (sep1 + 1, sep2)) >= 0
   952           && (blue = parse_float_color_comp (sep2 + 1, spec + len)) >= 0)
   953         {
   954           *r = lrint (red * 65535);
   955           *g = lrint (green * 65535);
   956           *b = lrint (blue * 65535);
   957           return true;
   958         }
   959     }
   960   return false;
   961 }
   962 
   963 DEFUN ("color-values-from-color-spec",
   964        Fcolor_values_from_color_spec,
   965        Scolor_values_from_color_spec,
   966        1, 1, 0,
   967        doc: /* Parse color SPEC as a numeric color and return (RED GREEN BLUE).
   968 This function recognizes the following formats for SPEC:
   969 
   970  #RGB, where R, G and B are hex numbers of equal length, 1-4 digits each.
   971  rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each.
   972  rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1].
   973 
   974 If SPEC is not in one of the above forms, return nil.
   975 
   976 Each of the 3 integer members of the resulting list, RED, GREEN, and BLUE,
   977 is normalized to have its value in [0,65535].  */)
   978   (Lisp_Object spec)
   979 {
   980   CHECK_STRING (spec);
   981   unsigned short r, g, b;
   982   return (parse_color_spec (SSDATA (spec), &r, &g, &b)
   983           ? list3i (r, g, b)
   984           : Qnil);
   985 }
   986 
   987 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
   988    RGB_LIST should contain (at least) 3 lisp integers.
   989    Return true iff RGB_LIST is OK.  */
   990 
   991 static bool
   992 parse_rgb_list (Lisp_Object rgb_list, Emacs_Color *color)
   993 {
   994 #define PARSE_RGB_LIST_FIELD(field)                                     \
   995   if (CONSP (rgb_list) && FIXNUMP (XCAR (rgb_list)))                    \
   996     {                                                                   \
   997       color->field = XFIXNUM (XCAR (rgb_list));                         \
   998       rgb_list = XCDR (rgb_list);                                       \
   999     }                                                                   \
  1000   else                                                                  \
  1001     return false;
  1002 
  1003   PARSE_RGB_LIST_FIELD (red);
  1004   PARSE_RGB_LIST_FIELD (green);
  1005   PARSE_RGB_LIST_FIELD (blue);
  1006 
  1007   return true;
  1008 }
  1009 
  1010 
  1011 /* Lookup on frame F the color described by the lisp string COLOR.
  1012    The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
  1013    non-zero, then the `standard' definition of the same color is
  1014    returned in it.  */
  1015 
  1016 static bool
  1017 tty_lookup_color (struct frame *f, Lisp_Object color, Emacs_Color *tty_color,
  1018                   Emacs_Color *std_color)
  1019 {
  1020   Lisp_Object frame, color_desc;
  1021 
  1022   if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc)))
  1023     return false;
  1024 
  1025   XSETFRAME (frame, f);
  1026 
  1027   color_desc = call2 (Qtty_color_desc, color, frame);
  1028   if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
  1029     {
  1030       Lisp_Object rgb;
  1031 
  1032       if (! FIXNUMP (XCAR (XCDR (color_desc))))
  1033         return false;
  1034 
  1035       tty_color->pixel = XFIXNUM (XCAR (XCDR (color_desc)));
  1036 
  1037       rgb = XCDR (XCDR (color_desc));
  1038       if (! parse_rgb_list (rgb, tty_color))
  1039         return false;
  1040 
  1041       /* Should we fill in STD_COLOR too?  */
  1042       if (std_color)
  1043         {
  1044           /* Default STD_COLOR to the same as TTY_COLOR.  */
  1045           *std_color = *tty_color;
  1046 
  1047           /* Do a quick check to see if the returned descriptor is
  1048              actually _exactly_ equal to COLOR, otherwise we have to
  1049              lookup STD_COLOR separately.  If it's impossible to lookup
  1050              a standard color, we just give up and use TTY_COLOR.  */
  1051           if ((!STRINGP (XCAR (color_desc))
  1052                || NILP (Fstring_equal (color, XCAR (color_desc))))
  1053               && !NILP (Ffboundp (Qtty_color_standard_values)))
  1054             {
  1055               /* Look up STD_COLOR separately.  */
  1056               rgb = call1 (Qtty_color_standard_values, color);
  1057               if (! parse_rgb_list (rgb, std_color))
  1058                 return false;
  1059             }
  1060         }
  1061 
  1062       return true;
  1063     }
  1064   else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
  1065     /* We were called early during startup, and the colors are not
  1066        yet set up in tty-defined-color-alist.  Don't return a failure
  1067        indication, since this produces the annoying "Unable to
  1068        load color" messages in the *Messages* buffer.  */
  1069     return true;
  1070   else
  1071     /* tty-color-desc seems to have returned a bad value.  */
  1072     return false;
  1073 }
  1074 
  1075 /* An implementation of defined_color_hook for tty frames.  */
  1076 
  1077 bool
  1078 tty_defined_color (struct frame *f, const char *color_name,
  1079                    Emacs_Color *color_def, bool alloc, bool _makeIndex)
  1080 {
  1081   bool status = true;
  1082 
  1083   /* Defaults.  */
  1084   color_def->pixel = FACE_TTY_DEFAULT_COLOR;
  1085   color_def->red = 0;
  1086   color_def->blue = 0;
  1087   color_def->green = 0;
  1088 
  1089   if (*color_name)
  1090     status = tty_lookup_color (f, build_string (color_name), color_def, NULL);
  1091 
  1092   if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
  1093     {
  1094       if (strcmp (color_name, "unspecified-fg") == 0)
  1095         color_def->pixel = FACE_TTY_DEFAULT_FG_COLOR;
  1096       else if (strcmp (color_name, "unspecified-bg") == 0)
  1097         color_def->pixel = FACE_TTY_DEFAULT_BG_COLOR;
  1098     }
  1099 
  1100   if (color_def->pixel != FACE_TTY_DEFAULT_COLOR)
  1101     status = true;
  1102 
  1103   return status;
  1104 }
  1105 
  1106 /* Given the index IDX of a tty color on frame F, return its name, a
  1107    Lisp string.  */
  1108 
  1109 Lisp_Object
  1110 tty_color_name (struct frame *f, int idx)
  1111 {
  1112   if (idx >= 0 && !NILP (Ffboundp (Qtty_color_by_index)))
  1113     {
  1114       Lisp_Object frame;
  1115       Lisp_Object coldesc;
  1116 
  1117       XSETFRAME (frame, f);
  1118       coldesc = call2 (Qtty_color_by_index, make_fixnum (idx), frame);
  1119 
  1120       if (!NILP (coldesc))
  1121         return XCAR (coldesc);
  1122     }
  1123 #ifdef MSDOS
  1124   /* We can have an MS-DOS frame under -nw for a short window of
  1125      opportunity before internal_terminal_init is called.  DTRT.  */
  1126   if (FRAME_MSDOS_P (f) && !inhibit_window_system)
  1127     return msdos_stdcolor_name (idx);
  1128 #endif
  1129 
  1130   if (idx == FACE_TTY_DEFAULT_FG_COLOR)
  1131     return build_string (unspecified_fg);
  1132   if (idx == FACE_TTY_DEFAULT_BG_COLOR)
  1133     return build_string (unspecified_bg);
  1134 
  1135   return Qunspecified;
  1136 }
  1137 
  1138 
  1139 /* Return true if COLOR_NAME is a shade of gray (or white or
  1140    black) on frame F.
  1141 
  1142    The criterion implemented here is not a terribly sophisticated one.  */
  1143 
  1144 static bool
  1145 face_color_gray_p (struct frame *f, const char *color_name)
  1146 {
  1147   Emacs_Color color;
  1148   bool gray_p;
  1149 
  1150   if (FRAME_TERMINAL (f)->defined_color_hook
  1151       (f, color_name, &color, false, true))
  1152     gray_p = (/* Any color sufficiently close to black counts as gray.  */
  1153               (color.red < 5000 && color.green < 5000 && color.blue < 5000)
  1154               ||
  1155               ((eabs (color.red - color.green)
  1156                 < max (color.red, color.green) / 20)
  1157                && (eabs (color.green - color.blue)
  1158                    < max (color.green, color.blue) / 20)
  1159                && (eabs (color.blue - color.red)
  1160                    < max (color.blue, color.red) / 20)));
  1161   else
  1162     gray_p = false;
  1163 
  1164   return gray_p;
  1165 }
  1166 
  1167 
  1168 /* Return true if color COLOR_NAME can be displayed on frame F.
  1169    BACKGROUND_P means the color will be used as background color.  */
  1170 
  1171 static bool
  1172 face_color_supported_p (struct frame *f, const char *color_name,
  1173                         bool background_p)
  1174 {
  1175   Lisp_Object frame;
  1176   Emacs_Color not_used;
  1177 
  1178   XSETFRAME (frame, f);
  1179   return
  1180 #ifdef HAVE_WINDOW_SYSTEM
  1181     FRAME_WINDOW_P (f)
  1182     ? (!NILP (Fxw_display_color_p (frame))
  1183        || xstrcasecmp (color_name, "black") == 0
  1184        || xstrcasecmp (color_name, "white") == 0
  1185        || (background_p
  1186            && face_color_gray_p (f, color_name))
  1187        || (!NILP (Fx_display_grayscale_p (frame))
  1188            && face_color_gray_p (f, color_name)))
  1189     :
  1190 #endif
  1191     tty_defined_color (f, color_name, &not_used, false, false);
  1192 }
  1193 
  1194 
  1195 DEFUN ("color-gray-p", Fcolor_gray_p, Scolor_gray_p, 1, 2, 0,
  1196        doc: /* Return non-nil if COLOR is a shade of gray (or white or black).
  1197 FRAME specifies the frame and thus the display for interpreting COLOR.
  1198 If FRAME is nil or omitted, use the selected frame.  */)
  1199   (Lisp_Object color, Lisp_Object frame)
  1200 {
  1201   CHECK_STRING (color);
  1202   return (face_color_gray_p (decode_any_frame (frame), SSDATA (color))
  1203           ? Qt : Qnil);
  1204 }
  1205 
  1206 
  1207 DEFUN ("color-supported-p", Fcolor_supported_p,
  1208        Scolor_supported_p, 1, 3, 0,
  1209        doc: /* Return non-nil if COLOR can be displayed on FRAME.
  1210 BACKGROUND-P non-nil means COLOR is used as a background.
  1211 Otherwise, this function tells whether it can be used as a foreground.
  1212 If FRAME is nil or omitted, use the selected frame.
  1213 COLOR must be a valid color name.  */)
  1214   (Lisp_Object color, Lisp_Object frame, Lisp_Object background_p)
  1215 {
  1216   CHECK_STRING (color);
  1217   return (face_color_supported_p (decode_any_frame (frame),
  1218                                   SSDATA (color), !NILP (background_p))
  1219           ? Qt : Qnil);
  1220 }
  1221 
  1222 
  1223 static unsigned long
  1224 load_color2 (struct frame *f, struct face *face, Lisp_Object name,
  1225              enum lface_attribute_index target_index, Emacs_Color *color)
  1226 {
  1227   eassert (STRINGP (name));
  1228   eassert (target_index == LFACE_FOREGROUND_INDEX
  1229            || target_index == LFACE_BACKGROUND_INDEX
  1230            || target_index == LFACE_UNDERLINE_INDEX
  1231            || target_index == LFACE_OVERLINE_INDEX
  1232            || target_index == LFACE_STRIKE_THROUGH_INDEX
  1233            || target_index == LFACE_BOX_INDEX);
  1234 
  1235   /* if the color map is full, defined_color_hook will return a best match
  1236      to the values in an existing cell. */
  1237   if (!FRAME_TERMINAL (f)->defined_color_hook
  1238       (f, SSDATA (name), color, true, true))
  1239     {
  1240       add_to_log ("Unable to load color \"%s\"", name);
  1241 
  1242       switch (target_index)
  1243         {
  1244         case LFACE_FOREGROUND_INDEX:
  1245           face->foreground_defaulted_p = true;
  1246           color->pixel = FRAME_FOREGROUND_PIXEL (f);
  1247           break;
  1248 
  1249         case LFACE_BACKGROUND_INDEX:
  1250           face->background_defaulted_p = true;
  1251           color->pixel = FRAME_BACKGROUND_PIXEL (f);
  1252           break;
  1253 
  1254         case LFACE_UNDERLINE_INDEX:
  1255           face->underline_defaulted_p = true;
  1256           color->pixel = FRAME_FOREGROUND_PIXEL (f);
  1257           break;
  1258 
  1259         case LFACE_OVERLINE_INDEX:
  1260           face->overline_color_defaulted_p = true;
  1261           color->pixel = FRAME_FOREGROUND_PIXEL (f);
  1262           break;
  1263 
  1264         case LFACE_STRIKE_THROUGH_INDEX:
  1265           face->strike_through_color_defaulted_p = true;
  1266           color->pixel = FRAME_FOREGROUND_PIXEL (f);
  1267           break;
  1268 
  1269         case LFACE_BOX_INDEX:
  1270           face->box_color_defaulted_p = true;
  1271           color->pixel = FRAME_FOREGROUND_PIXEL (f);
  1272           break;
  1273 
  1274         default:
  1275           emacs_abort ();
  1276         }
  1277     }
  1278 #ifdef GLYPH_DEBUG
  1279   else
  1280     ++ncolors_allocated;
  1281 #endif
  1282 
  1283   return color->pixel;
  1284 }
  1285 
  1286 /* Load color with name NAME for use by face FACE on frame F.
  1287    TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
  1288    LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
  1289    LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX.  Value is the
  1290    pixel color.  If color cannot be loaded, display a message, and
  1291    return the foreground, background or underline color of F, but
  1292    record that fact in flags of the face so that we don't try to free
  1293    these colors.  */
  1294 
  1295 unsigned long
  1296 load_color (struct frame *f, struct face *face, Lisp_Object name,
  1297             enum lface_attribute_index target_index)
  1298 {
  1299   Emacs_Color color;
  1300   return load_color2 (f, face, name, target_index, &color);
  1301 }
  1302 
  1303 
  1304 #ifdef HAVE_WINDOW_SYSTEM
  1305 
  1306 /* Load colors for face FACE which is used on frame F.  Colors are
  1307    specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
  1308    of ATTRS.  If the background color specified is not supported on F,
  1309    try to emulate gray colors with a stipple from Vface_default_stipple.  */
  1310 
  1311 static void
  1312 load_face_colors (struct frame *f, struct face *face,
  1313                   Lisp_Object attrs[LFACE_VECTOR_SIZE])
  1314 {
  1315   Lisp_Object fg, bg, dfg;
  1316   Emacs_Color xfg, xbg;
  1317 
  1318   bg = attrs[LFACE_BACKGROUND_INDEX];
  1319   fg = attrs[LFACE_FOREGROUND_INDEX];
  1320 
  1321   /* Swap colors if face is inverse-video.  */
  1322   if (EQ (attrs[LFACE_INVERSE_INDEX], Qt))
  1323     {
  1324       Lisp_Object tmp;
  1325       tmp = fg;
  1326       fg = bg;
  1327       bg = tmp;
  1328     }
  1329 
  1330   /* Check for support for foreground, not for background because
  1331      face_color_supported_p is smart enough to know that grays are
  1332      "supported" as background because we are supposed to use stipple
  1333      for them.  */
  1334   if (!face_color_supported_p (f, SSDATA (bg), false)
  1335       && !NILP (Fbitmap_spec_p (Vface_default_stipple)))
  1336     {
  1337       image_destroy_bitmap (f, face->stipple);
  1338       face->stipple = load_pixmap (f, Vface_default_stipple);
  1339     }
  1340 
  1341   face->background = load_color2 (f, face, bg, LFACE_BACKGROUND_INDEX, &xbg);
  1342   face->foreground = load_color2 (f, face, fg, LFACE_FOREGROUND_INDEX, &xfg);
  1343 
  1344   dfg = attrs[LFACE_DISTANT_FOREGROUND_INDEX];
  1345   if (!NILP (dfg) && !UNSPECIFIEDP (dfg)
  1346       && color_distance (&xbg, &xfg) < face_near_same_color_threshold)
  1347     {
  1348       if (EQ (attrs[LFACE_INVERSE_INDEX], Qt))
  1349         face->background = load_color (f, face, dfg, LFACE_BACKGROUND_INDEX);
  1350       else
  1351         face->foreground = load_color (f, face, dfg, LFACE_FOREGROUND_INDEX);
  1352     }
  1353 }
  1354 
  1355 #ifdef HAVE_X_WINDOWS
  1356 
  1357 /* Free color PIXEL on frame F.  */
  1358 
  1359 void
  1360 unload_color (struct frame *f, unsigned long pixel)
  1361 {
  1362   if (pixel != -1)
  1363     {
  1364       block_input ();
  1365       x_free_colors (f, &pixel, 1);
  1366       unblock_input ();
  1367     }
  1368 }
  1369 
  1370 /* Free colors allocated for FACE.  */
  1371 
  1372 static void
  1373 free_face_colors (struct frame *f, struct face *face)
  1374 {
  1375   /* PENDING(NS): need to do something here? */
  1376 
  1377   if (face->colors_copied_bitwise_p)
  1378     return;
  1379 
  1380   block_input ();
  1381 
  1382   if (!face->foreground_defaulted_p)
  1383     {
  1384       x_free_colors (f, &face->foreground, 1);
  1385       IF_DEBUG (--ncolors_allocated);
  1386     }
  1387 
  1388   if (!face->background_defaulted_p)
  1389     {
  1390       x_free_colors (f, &face->background, 1);
  1391       IF_DEBUG (--ncolors_allocated);
  1392     }
  1393 
  1394   if (face->underline
  1395       && !face->underline_defaulted_p)
  1396     {
  1397       x_free_colors (f, &face->underline_color, 1);
  1398       IF_DEBUG (--ncolors_allocated);
  1399     }
  1400 
  1401   if (face->overline_p
  1402       && !face->overline_color_defaulted_p)
  1403     {
  1404       x_free_colors (f, &face->overline_color, 1);
  1405       IF_DEBUG (--ncolors_allocated);
  1406     }
  1407 
  1408   if (face->strike_through_p
  1409       && !face->strike_through_color_defaulted_p)
  1410     {
  1411       x_free_colors (f, &face->strike_through_color, 1);
  1412       IF_DEBUG (--ncolors_allocated);
  1413     }
  1414 
  1415   if (face->box != FACE_NO_BOX
  1416       && !face->box_color_defaulted_p)
  1417     {
  1418       x_free_colors (f, &face->box_color, 1);
  1419       IF_DEBUG (--ncolors_allocated);
  1420     }
  1421 
  1422   unblock_input ();
  1423 }
  1424 
  1425 #endif /* HAVE_X_WINDOWS */
  1426 
  1427 #endif /* HAVE_WINDOW_SYSTEM */
  1428 
  1429 
  1430 
  1431 /***********************************************************************
  1432                            XLFD Font Names
  1433  ***********************************************************************/
  1434 
  1435 /* An enumerator for each field of an XLFD font name.  */
  1436 
  1437 enum xlfd_field
  1438 {
  1439   XLFD_FOUNDRY,
  1440   XLFD_FAMILY,
  1441   XLFD_WEIGHT,
  1442   XLFD_SLANT,
  1443   XLFD_SWIDTH,
  1444   XLFD_ADSTYLE,
  1445   XLFD_PIXEL_SIZE,
  1446   XLFD_POINT_SIZE,
  1447   XLFD_RESX,
  1448   XLFD_RESY,
  1449   XLFD_SPACING,
  1450   XLFD_AVGWIDTH,
  1451   XLFD_REGISTRY,
  1452   XLFD_ENCODING,
  1453   XLFD_LAST
  1454 };
  1455 
  1456 /* Order by which font selection chooses fonts.  The default values
  1457    mean "first, find a best match for the font width, then for the
  1458    font height, then for weight, then for slant."  This variable can be
  1459    set via 'internal-set-font-selection-order'.  */
  1460 
  1461 static int font_sort_order[4];
  1462 
  1463 #ifdef HAVE_WINDOW_SYSTEM
  1464 
  1465 static enum font_property_index font_props_for_sorting[FONT_SIZE_INDEX];
  1466 
  1467 static int
  1468 compare_fonts_by_sort_order (const void *v1, const void *v2)
  1469 {
  1470   Lisp_Object const *p1 = v1;
  1471   Lisp_Object const *p2 = v2;
  1472   Lisp_Object font1 = *p1;
  1473   Lisp_Object font2 = *p2;
  1474   int i;
  1475 
  1476   for (i = 0; i < FONT_SIZE_INDEX; i++)
  1477     {
  1478       enum font_property_index idx = font_props_for_sorting[i];
  1479       Lisp_Object val1 = AREF (font1, idx), val2 = AREF (font2, idx);
  1480       int result;
  1481 
  1482       if (idx <= FONT_REGISTRY_INDEX)
  1483         {
  1484           if (STRINGP (val1))
  1485             result = STRINGP (val2) ? strcmp (SSDATA (val1), SSDATA (val2)) : -1;
  1486           else
  1487             result = STRINGP (val2) ? 1 : 0;
  1488         }
  1489       else
  1490         {
  1491           if (FIXNUMP (val1))
  1492             result = (FIXNUMP (val2) && XFIXNUM (val1) >= XFIXNUM (val2)
  1493                       ? XFIXNUM (val1) > XFIXNUM (val2)
  1494                       : -1);
  1495           else
  1496             result = FIXNUMP (val2) ? 1 : 0;
  1497         }
  1498       if (result)
  1499         return result;
  1500     }
  1501   return 0;
  1502 }
  1503 
  1504 DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
  1505        doc: /* Return a list of available fonts of family FAMILY on FRAME.
  1506 If FAMILY is omitted or nil, list all families.
  1507 Otherwise, FAMILY must be a string, possibly containing wildcards
  1508 `?' and `*'.
  1509 If FRAME is omitted or nil, use the selected frame.
  1510 
  1511 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
  1512 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
  1513 
  1514 FAMILY is the font family name.
  1515 POINT-SIZE is the size of the font in 1/10 pt.
  1516 WIDTH, WEIGHT, and SLANT are symbols describing the width, weight
  1517   and slant of the font.  These symbols are the same as for face
  1518   attributes, see `set-face-attribute'.
  1519 FIXED-P is non-nil if the font is fixed-pitch.
  1520 FULL is the full name of the font.
  1521 REGISTRY-AND-ENCODING is a string giving the registry and encoding of
  1522   the font.
  1523 
  1524 The resulting list is sorted according to the current setting of
  1525 the face font sort order, see `face-font-selection-order'.  */)
  1526   (Lisp_Object family, Lisp_Object frame)
  1527 {
  1528   Lisp_Object font_spec, list, *drivers, vec;
  1529   struct frame *f = decode_live_frame (frame);
  1530   ptrdiff_t i, nfonts;
  1531   Lisp_Object result;
  1532   USE_SAFE_ALLOCA;
  1533 
  1534   font_spec = Ffont_spec (0, NULL);
  1535   if (!NILP (family))
  1536     {
  1537       CHECK_STRING (family);
  1538       font_parse_family_registry (family, Qnil, font_spec);
  1539     }
  1540 
  1541   list = font_list_entities (f, font_spec);
  1542   if (NILP (list))
  1543     return Qnil;
  1544 
  1545   /* Sort the font entities.  */
  1546   for (i = 0; i < 4; i++)
  1547     switch (font_sort_order[i])
  1548       {
  1549       case XLFD_SWIDTH:
  1550         font_props_for_sorting[i] = FONT_WIDTH_INDEX; break;
  1551       case XLFD_POINT_SIZE:
  1552         font_props_for_sorting[i] = FONT_SIZE_INDEX; break;
  1553       case XLFD_WEIGHT:
  1554         font_props_for_sorting[i] = FONT_WEIGHT_INDEX; break;
  1555       default:
  1556         font_props_for_sorting[i] = FONT_SLANT_INDEX; break;
  1557       }
  1558   font_props_for_sorting[i++] = FONT_FAMILY_INDEX;
  1559   font_props_for_sorting[i++] = FONT_FOUNDRY_INDEX;
  1560   font_props_for_sorting[i++] = FONT_ADSTYLE_INDEX;
  1561   font_props_for_sorting[i++] = FONT_REGISTRY_INDEX;
  1562 
  1563   ptrdiff_t ndrivers = list_length (list);
  1564   SAFE_ALLOCA_LISP (drivers, ndrivers);
  1565   for (i = 0; i < ndrivers; i++, list = XCDR (list))
  1566     drivers[i] = XCAR (list);
  1567   vec = Fvconcat (ndrivers, drivers);
  1568   nfonts = ASIZE (vec);
  1569 
  1570   qsort (XVECTOR (vec)->contents, nfonts, word_size,
  1571          compare_fonts_by_sort_order);
  1572 
  1573   result = Qnil;
  1574   for (i = nfonts - 1; i >= 0; --i)
  1575     {
  1576       Lisp_Object font = AREF (vec, i);
  1577       int point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
  1578                                   FRAME_RES_Y (f));
  1579       Lisp_Object spacing = Ffont_get (font, QCspacing);
  1580       Lisp_Object v = CALLN (Fvector,
  1581                              AREF (font, FONT_FAMILY_INDEX),
  1582                              FONT_WIDTH_SYMBOLIC (font),
  1583                              make_fixnum (point),
  1584                              FONT_WEIGHT_SYMBOLIC (font),
  1585                              FONT_SLANT_SYMBOLIC (font),
  1586                              (NILP (spacing)
  1587                               || EQ (spacing, Qp)
  1588                               /* If the font was specified in a way
  1589                                  different from XLFD (e.g., on MS-Windows),
  1590                                  we will have a number there, not 'p'.  */
  1591                               || BASE_EQ (spacing,
  1592                                           make_fixnum
  1593                                           (FONT_SPACING_PROPORTIONAL)))
  1594                              ? Qnil : Qt,
  1595                              Ffont_xlfd_name (font, Qnil),
  1596                              AREF (font, FONT_REGISTRY_INDEX));
  1597       result = Fcons (v, result);
  1598     }
  1599 
  1600   SAFE_FREE ();
  1601   return result;
  1602 }
  1603 
  1604 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
  1605        doc: /* Return a list of the names of available fonts matching PATTERN.
  1606 If optional arguments FACE and FRAME are specified, return only fonts
  1607 the same size as FACE on FRAME.
  1608 
  1609 PATTERN should be a string containing a font name in the XLFD,
  1610 Fontconfig, or GTK format.  A font name given in the XLFD format may
  1611 contain wildcard characters:
  1612   the * character matches any substring, and
  1613   the ? character matches any single character.
  1614   PATTERN is case-insensitive.
  1615 
  1616 The return value is a list of strings, suitable as arguments to
  1617 `set-face-font'.
  1618 
  1619 Fonts Emacs can't use may or may not be excluded
  1620 even if they match PATTERN and FACE.
  1621 The optional fourth argument MAXIMUM sets a limit on how many
  1622 fonts to match.  The first MAXIMUM fonts are reported.
  1623 The optional fifth argument WIDTH, if specified, is a number of columns
  1624 occupied by a character of a font.  In that case, return only fonts
  1625 the WIDTH times as wide as FACE on FRAME.  */)
  1626   (Lisp_Object pattern, Lisp_Object face, Lisp_Object frame,
  1627    Lisp_Object maximum, Lisp_Object width)
  1628 {
  1629   struct frame *f;
  1630   int size, avgwidth;
  1631 
  1632   check_window_system (NULL);
  1633   CHECK_STRING (pattern);
  1634 
  1635   if (! NILP (maximum))
  1636     CHECK_FIXNAT (maximum);
  1637 
  1638   if (!NILP (width))
  1639     CHECK_FIXNUM (width);
  1640 
  1641   /* We can't simply call decode_window_system_frame because
  1642      this function may be called before any frame is created.  */
  1643   f = decode_live_frame (frame);
  1644   if (! FRAME_WINDOW_P (f))
  1645     {
  1646       /* Perhaps we have not yet created any frame.  */
  1647       f = NULL;
  1648       frame = Qnil;
  1649       face = Qnil;
  1650     }
  1651   else
  1652     XSETFRAME (frame, f);
  1653 
  1654   /* Determine the width standard for comparison with the fonts we find.  */
  1655 
  1656   if (NILP (face))
  1657     size = 0;
  1658   else
  1659     {
  1660       /* This is of limited utility since it works with character
  1661          widths.  Keep it for compatibility.  --gerd.  */
  1662       int face_id = lookup_named_face (NULL, f, face, false);
  1663       struct face *width_face = FACE_FROM_ID_OR_NULL (f, face_id);
  1664 
  1665       if (width_face && width_face->font)
  1666         {
  1667           size = width_face->font->pixel_size;
  1668           avgwidth = width_face->font->average_width;
  1669         }
  1670       else
  1671         {
  1672           size = FRAME_FONT (f)->pixel_size;
  1673           avgwidth = FRAME_FONT (f)->average_width;
  1674         }
  1675       if (!NILP (width))
  1676         avgwidth *= XFIXNUM (width);
  1677     }
  1678 
  1679   Lisp_Object font_spec = font_spec_from_name (pattern);
  1680   if (!FONTP (font_spec))
  1681     signal_error ("Invalid font name", pattern);
  1682 
  1683   if (size)
  1684     {
  1685       Ffont_put (font_spec, QCsize, make_fixnum (size));
  1686       Ffont_put (font_spec, QCavgwidth, make_fixnum (avgwidth));
  1687     }
  1688   Lisp_Object fonts = Flist_fonts (font_spec, frame, maximum, font_spec);
  1689   for (Lisp_Object tail = fonts; CONSP (tail); tail = XCDR (tail))
  1690     {
  1691       Lisp_Object font_entity;
  1692 
  1693       font_entity = XCAR (tail);
  1694       if ((NILP (AREF (font_entity, FONT_SIZE_INDEX))
  1695            || XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)) == 0)
  1696           && ! NILP (AREF (font_spec, FONT_SIZE_INDEX)))
  1697         {
  1698           /* This is a scalable font.  For backward compatibility,
  1699              we set the specified size. */
  1700           font_entity = copy_font_spec (font_entity);
  1701           ASET (font_entity, FONT_SIZE_INDEX,
  1702                 AREF (font_spec, FONT_SIZE_INDEX));
  1703         }
  1704       XSETCAR (tail, Ffont_xlfd_name (font_entity, Qnil));
  1705     }
  1706   if (NILP (frame))
  1707     /* We don't have to check fontsets.  */
  1708     return fonts;
  1709   Lisp_Object fontsets = list_fontsets (f, pattern, size);
  1710   return nconc2 (fonts, fontsets);
  1711 }
  1712 
  1713 #endif /* HAVE_WINDOW_SYSTEM */
  1714 
  1715 
  1716 /***********************************************************************
  1717                               Lisp Faces
  1718  ***********************************************************************/
  1719 
  1720 /* Access face attributes of face LFACE, a Lisp vector.  */
  1721 
  1722 #define LFACE_FAMILY(LFACE)         AREF ((LFACE), LFACE_FAMILY_INDEX)
  1723 #define LFACE_FOUNDRY(LFACE)        AREF ((LFACE), LFACE_FOUNDRY_INDEX)
  1724 #define LFACE_HEIGHT(LFACE)         AREF ((LFACE), LFACE_HEIGHT_INDEX)
  1725 #define LFACE_WEIGHT(LFACE)         AREF ((LFACE), LFACE_WEIGHT_INDEX)
  1726 #define LFACE_SLANT(LFACE)          AREF ((LFACE), LFACE_SLANT_INDEX)
  1727 #define LFACE_UNDERLINE(LFACE)      AREF ((LFACE), LFACE_UNDERLINE_INDEX)
  1728 #define LFACE_INVERSE(LFACE)        AREF ((LFACE), LFACE_INVERSE_INDEX)
  1729 #define LFACE_FOREGROUND(LFACE)     AREF ((LFACE), LFACE_FOREGROUND_INDEX)
  1730 #define LFACE_BACKGROUND(LFACE)     AREF ((LFACE), LFACE_BACKGROUND_INDEX)
  1731 #define LFACE_STIPPLE(LFACE)        AREF ((LFACE), LFACE_STIPPLE_INDEX)
  1732 #define LFACE_SWIDTH(LFACE)         AREF ((LFACE), LFACE_SWIDTH_INDEX)
  1733 #define LFACE_OVERLINE(LFACE)       AREF ((LFACE), LFACE_OVERLINE_INDEX)
  1734 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
  1735 #define LFACE_BOX(LFACE)            AREF ((LFACE), LFACE_BOX_INDEX)
  1736 #define LFACE_FONT(LFACE)           AREF ((LFACE), LFACE_FONT_INDEX)
  1737 #define LFACE_INHERIT(LFACE)        AREF ((LFACE), LFACE_INHERIT_INDEX)
  1738 #define LFACE_FONTSET(LFACE)        AREF ((LFACE), LFACE_FONTSET_INDEX)
  1739 #define LFACE_EXTEND(LFACE)         AREF ((LFACE), LFACE_EXTEND_INDEX)
  1740 #define LFACE_DISTANT_FOREGROUND(LFACE) \
  1741   AREF ((LFACE), LFACE_DISTANT_FOREGROUND_INDEX)
  1742 
  1743 /* True if LFACE is a Lisp face.  A Lisp face is a vector of size
  1744    LFACE_VECTOR_SIZE which has the symbol `face' in slot 0.  */
  1745 
  1746 #define LFACEP(LFACE)                                   \
  1747      (VECTORP (LFACE)                                   \
  1748       && ASIZE (LFACE) == LFACE_VECTOR_SIZE             \
  1749       && EQ (AREF (LFACE, 0), Qface))
  1750 
  1751 
  1752 /* Face attribute symbols for each value of LFACE_*_INDEX.  */
  1753 static Lisp_Object face_attr_sym[LFACE_VECTOR_SIZE];
  1754 
  1755 #ifdef GLYPH_DEBUG
  1756 
  1757 /* Check consistency of Lisp face attribute vector ATTRS.  */
  1758 
  1759 static void
  1760 check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE])
  1761 {
  1762   eassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
  1763            || IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
  1764            || RESET_P (attrs[LFACE_FAMILY_INDEX])
  1765            || STRINGP (attrs[LFACE_FAMILY_INDEX]));
  1766   eassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
  1767            || IGNORE_DEFFACE_P (attrs[LFACE_FOUNDRY_INDEX])
  1768            || RESET_P (attrs[LFACE_FOUNDRY_INDEX])
  1769            || STRINGP (attrs[LFACE_FOUNDRY_INDEX]));
  1770   eassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
  1771            || IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX])
  1772            || RESET_P (attrs[LFACE_SWIDTH_INDEX])
  1773            || SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
  1774   eassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
  1775            || IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX])
  1776            || RESET_P (attrs[LFACE_HEIGHT_INDEX])
  1777            || NUMBERP (attrs[LFACE_HEIGHT_INDEX])
  1778            || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX]));
  1779   eassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
  1780            || IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX])
  1781            || RESET_P (attrs[LFACE_WEIGHT_INDEX])
  1782            || SYMBOLP (attrs[LFACE_WEIGHT_INDEX]));
  1783   eassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
  1784            || IGNORE_DEFFACE_P (attrs[LFACE_SLANT_INDEX])
  1785            || RESET_P (attrs[LFACE_SLANT_INDEX])
  1786            || SYMBOLP (attrs[LFACE_SLANT_INDEX]));
  1787   eassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
  1788            || IGNORE_DEFFACE_P (attrs[LFACE_UNDERLINE_INDEX])
  1789            || RESET_P (attrs[LFACE_UNDERLINE_INDEX])
  1790            || SYMBOLP (attrs[LFACE_UNDERLINE_INDEX])
  1791            || STRINGP (attrs[LFACE_UNDERLINE_INDEX])
  1792            || CONSP (attrs[LFACE_UNDERLINE_INDEX]));
  1793   eassert (UNSPECIFIEDP (attrs[LFACE_EXTEND_INDEX])
  1794            || IGNORE_DEFFACE_P (attrs[LFACE_EXTEND_INDEX])
  1795            || RESET_P (attrs[LFACE_EXTEND_INDEX])
  1796            || SYMBOLP (attrs[LFACE_EXTEND_INDEX])
  1797            || STRINGP (attrs[LFACE_EXTEND_INDEX]));
  1798   eassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
  1799            || IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX])
  1800            || RESET_P (attrs[LFACE_OVERLINE_INDEX])
  1801            || SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
  1802            || STRINGP (attrs[LFACE_OVERLINE_INDEX]));
  1803   eassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
  1804            || IGNORE_DEFFACE_P (attrs[LFACE_STRIKE_THROUGH_INDEX])
  1805            || RESET_P (attrs[LFACE_STRIKE_THROUGH_INDEX])
  1806            || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
  1807            || STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX]));
  1808   eassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
  1809            || IGNORE_DEFFACE_P (attrs[LFACE_BOX_INDEX])
  1810            || RESET_P (attrs[LFACE_BOX_INDEX])
  1811            || SYMBOLP (attrs[LFACE_BOX_INDEX])
  1812            || STRINGP (attrs[LFACE_BOX_INDEX])
  1813            || FIXNUMP (attrs[LFACE_BOX_INDEX])
  1814            || CONSP (attrs[LFACE_BOX_INDEX]));
  1815   eassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
  1816            || IGNORE_DEFFACE_P (attrs[LFACE_INVERSE_INDEX])
  1817            || RESET_P (attrs[LFACE_INVERSE_INDEX])
  1818            || SYMBOLP (attrs[LFACE_INVERSE_INDEX]));
  1819   eassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
  1820            || IGNORE_DEFFACE_P (attrs[LFACE_FOREGROUND_INDEX])
  1821            || RESET_P (attrs[LFACE_FOREGROUND_INDEX])
  1822            || STRINGP (attrs[LFACE_FOREGROUND_INDEX]));
  1823   eassert (UNSPECIFIEDP (attrs[LFACE_DISTANT_FOREGROUND_INDEX])
  1824            || IGNORE_DEFFACE_P (attrs[LFACE_DISTANT_FOREGROUND_INDEX])
  1825            || RESET_P (attrs[LFACE_DISTANT_FOREGROUND_INDEX])
  1826            || STRINGP (attrs[LFACE_DISTANT_FOREGROUND_INDEX]));
  1827   eassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
  1828            || IGNORE_DEFFACE_P (attrs[LFACE_BACKGROUND_INDEX])
  1829            || RESET_P (attrs[LFACE_BACKGROUND_INDEX])
  1830            || STRINGP (attrs[LFACE_BACKGROUND_INDEX]));
  1831   eassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
  1832            || IGNORE_DEFFACE_P (attrs[LFACE_INHERIT_INDEX])
  1833            || NILP (attrs[LFACE_INHERIT_INDEX])
  1834            || SYMBOLP (attrs[LFACE_INHERIT_INDEX])
  1835            || CONSP (attrs[LFACE_INHERIT_INDEX]));
  1836 #ifdef HAVE_WINDOW_SYSTEM
  1837   eassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
  1838            || IGNORE_DEFFACE_P (attrs[LFACE_STIPPLE_INDEX])
  1839            || RESET_P (attrs[LFACE_STIPPLE_INDEX])
  1840            || SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
  1841            || !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
  1842   eassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
  1843            || IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX])
  1844            || RESET_P (attrs[LFACE_FONT_INDEX])
  1845            || FONTP (attrs[LFACE_FONT_INDEX]));
  1846   eassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
  1847            || STRINGP (attrs[LFACE_FONTSET_INDEX])
  1848            || RESET_P (attrs[LFACE_FONTSET_INDEX])
  1849            || NILP (attrs[LFACE_FONTSET_INDEX]));
  1850 #endif
  1851 }
  1852 
  1853 
  1854 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector).  */
  1855 
  1856 static void
  1857 check_lface (Lisp_Object lface)
  1858 {
  1859   if (!NILP (lface))
  1860     {
  1861       eassert (LFACEP (lface));
  1862       check_lface_attrs (XVECTOR (lface)->contents);
  1863     }
  1864 }
  1865 
  1866 #else /* not GLYPH_DEBUG */
  1867 
  1868 #define check_lface_attrs(attrs)        (void) 0
  1869 #define check_lface(lface)              (void) 0
  1870 
  1871 #endif /* GLYPH_DEBUG */
  1872 
  1873 
  1874 
  1875 /* Face-merge cycle checking.  */
  1876 
  1877 enum named_merge_point_kind
  1878 {
  1879   NAMED_MERGE_POINT_NORMAL,
  1880   NAMED_MERGE_POINT_REMAP
  1881 };
  1882 
  1883 /* A `named merge point' is simply a point during face-merging where we
  1884    look up a face by name.  We keep a stack of which named lookups we're
  1885    currently processing so that we can easily detect cycles, using a
  1886    linked- list of struct named_merge_point structures, typically
  1887    allocated on the stack frame of the named lookup functions which are
  1888    active (so no consing is required).  */
  1889 struct named_merge_point
  1890 {
  1891   Lisp_Object face_name;
  1892   enum named_merge_point_kind named_merge_point_kind;
  1893   struct named_merge_point *prev;
  1894 };
  1895 
  1896 
  1897 /* If a face merging cycle is detected for FACE_NAME, return false,
  1898    otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
  1899    FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
  1900    pointed to by NAMED_MERGE_POINTS, and return true.  */
  1901 
  1902 static bool
  1903 push_named_merge_point (struct named_merge_point *new_named_merge_point,
  1904                         Lisp_Object face_name,
  1905                         enum named_merge_point_kind named_merge_point_kind,
  1906                         struct named_merge_point **named_merge_points)
  1907 {
  1908   struct named_merge_point *prev;
  1909 
  1910   for (prev = *named_merge_points; prev; prev = prev->prev)
  1911     if (EQ (face_name, prev->face_name))
  1912       {
  1913         if (prev->named_merge_point_kind == named_merge_point_kind)
  1914           /* A cycle, so fail.  */
  1915           return false;
  1916         else if (prev->named_merge_point_kind == NAMED_MERGE_POINT_REMAP)
  1917           /* A remap `hides ' any previous normal merge points
  1918              (because the remap means that it's actually different face),
  1919              so as we know the current merge point must be normal, we
  1920              can just assume it's OK.  */
  1921           break;
  1922       }
  1923 
  1924   new_named_merge_point->face_name = face_name;
  1925   new_named_merge_point->named_merge_point_kind = named_merge_point_kind;
  1926   new_named_merge_point->prev = *named_merge_points;
  1927 
  1928   *named_merge_points = new_named_merge_point;
  1929 
  1930   return true;
  1931 }
  1932 
  1933 
  1934 /* Resolve face name FACE_NAME.  If FACE_NAME is a string, intern it
  1935    to make it a symbol.  If FACE_NAME is an alias for another face,
  1936    return that face's name.
  1937 
  1938    Return default face in case of errors.  */
  1939 
  1940 static Lisp_Object
  1941 resolve_face_name (Lisp_Object face_name, bool signal_p)
  1942 {
  1943   Lisp_Object orig_face;
  1944   Lisp_Object tortoise, hare;
  1945 
  1946   if (STRINGP (face_name))
  1947     face_name = Fintern (face_name, Qnil);
  1948 
  1949   if (NILP (face_name) || !SYMBOLP (face_name))
  1950     return face_name;
  1951 
  1952   orig_face = face_name;
  1953   tortoise = hare = face_name;
  1954 
  1955   while (true)
  1956     {
  1957       face_name = hare;
  1958       hare = Fget (hare, Qface_alias);
  1959       if (NILP (hare) || !SYMBOLP (hare))
  1960         break;
  1961 
  1962       face_name = hare;
  1963       hare = Fget (hare, Qface_alias);
  1964       if (NILP (hare) || !SYMBOLP (hare))
  1965         break;
  1966 
  1967       tortoise = Fget (tortoise, Qface_alias);
  1968       if (BASE_EQ (hare, tortoise))
  1969         {
  1970           if (signal_p)
  1971             circular_list (orig_face);
  1972           return Qdefault;
  1973         }
  1974     }
  1975 
  1976   return face_name;
  1977 }
  1978 
  1979 
  1980 /* Return the face definition of FACE_NAME on frame F.  F null means
  1981    return the definition for new frames.  FACE_NAME may be a string or
  1982    a symbol (apparently Emacs 20.2 allowed strings as face names in
  1983    face text properties; Ediff uses that).
  1984    If SIGNAL_P, signal an error if FACE_NAME is not a valid face name.
  1985    Otherwise, value is nil if FACE_NAME is not a valid face name.  */
  1986 static Lisp_Object
  1987 lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name,
  1988                                  bool signal_p)
  1989 {
  1990   Lisp_Object lface;
  1991 
  1992   if (f)
  1993     lface = Fgethash (face_name, f->face_hash_table, Qnil);
  1994   else
  1995     lface = CDR (Fgethash (face_name, Vface_new_frame_defaults, Qnil));
  1996 
  1997   if (signal_p && NILP (lface))
  1998     signal_error ("Invalid face", face_name);
  1999 
  2000   check_lface (lface);
  2001 
  2002   return lface;
  2003 }
  2004 
  2005 /* Return the face definition of FACE_NAME on frame F.  F null means
  2006    return the definition for new frames.  FACE_NAME may be a string or
  2007    a symbol (apparently Emacs 20.2 allowed strings as face names in
  2008    face text properties; Ediff uses that).  If FACE_NAME is an alias
  2009    for another face, return that face's definition.
  2010    If SIGNAL_P, signal an error if FACE_NAME is not a valid face name.
  2011    Otherwise, value is nil if FACE_NAME is not a valid face name.  */
  2012 static Lisp_Object
  2013 lface_from_face_name (struct frame *f, Lisp_Object face_name, bool signal_p)
  2014 {
  2015   face_name = resolve_face_name (face_name, signal_p);
  2016   return lface_from_face_name_no_resolve (f, face_name, signal_p);
  2017 }
  2018 
  2019 
  2020 /* Get face attributes of face FACE_NAME from frame-local faces on
  2021    frame F.  Store the resulting attributes in ATTRS which must point
  2022    to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE.
  2023    If SIGNAL_P, signal an error if FACE_NAME does not name a face.
  2024    Otherwise, return true iff FACE_NAME is a face.  */
  2025 
  2026 static bool
  2027 get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name,
  2028                                Lisp_Object attrs[LFACE_VECTOR_SIZE],
  2029                                bool signal_p)
  2030 {
  2031   Lisp_Object lface;
  2032 
  2033   lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
  2034 
  2035   if (! NILP (lface))
  2036     memcpy (attrs, xvector_contents (lface),
  2037             LFACE_VECTOR_SIZE * sizeof *attrs);
  2038 
  2039   return !NILP (lface);
  2040 }
  2041 
  2042 /* Get face attributes of face FACE_NAME from frame-local faces on
  2043    frame F.  Store the resulting attributes in ATTRS which must point
  2044    to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE.
  2045    If FACE_NAME is an alias for another face, use that face's
  2046    definition.  If SIGNAL_P, signal an error if FACE_NAME does not
  2047    name a face.  Otherwise, return true iff FACE_NAME is a face.  If W
  2048    is non-NULL, also consider remappings attached to the window.
  2049    */
  2050 static bool
  2051 get_lface_attributes (struct window *w,
  2052                       struct frame *f, Lisp_Object face_name,
  2053                       Lisp_Object attrs[LFACE_VECTOR_SIZE], bool signal_p,
  2054                       struct named_merge_point *named_merge_points)
  2055 {
  2056   Lisp_Object face_remapping;
  2057   eassert (w == NULL || WINDOW_XFRAME (w) == f);
  2058 
  2059   face_name = resolve_face_name (face_name, signal_p);
  2060 
  2061   /* See if SYMBOL has been remapped to some other face (usually this
  2062      is done buffer-locally).  */
  2063   face_remapping = assq_no_quit (face_name, Vface_remapping_alist);
  2064   if (CONSP (face_remapping))
  2065     {
  2066       struct named_merge_point named_merge_point;
  2067 
  2068       if (push_named_merge_point (&named_merge_point,
  2069                                   face_name, NAMED_MERGE_POINT_REMAP,
  2070                                   &named_merge_points))
  2071         {
  2072           int i;
  2073 
  2074           for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
  2075             attrs[i] = Qunspecified;
  2076 
  2077           return merge_face_ref (w, f, XCDR (face_remapping), attrs,
  2078                                  signal_p, named_merge_points,
  2079                                  0);
  2080         }
  2081     }
  2082 
  2083   /* Default case, no remapping.  */
  2084   return get_lface_attributes_no_remap (f, face_name, attrs, signal_p);
  2085 }
  2086 
  2087 
  2088 /* True iff all attributes in face attribute vector ATTRS are
  2089    specified, i.e. are non-nil.  */
  2090 
  2091 static bool
  2092 lface_fully_specified_p (Lisp_Object attrs[LFACE_VECTOR_SIZE])
  2093 {
  2094   int i;
  2095 
  2096   for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
  2097     if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
  2098         && i != LFACE_DISTANT_FOREGROUND_INDEX)
  2099       if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])))
  2100         break;
  2101 
  2102   return i == LFACE_VECTOR_SIZE;
  2103 }
  2104 
  2105 #ifdef HAVE_WINDOW_SYSTEM
  2106 
  2107 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
  2108    If FORCE_P is zero, set only unspecified attributes of LFACE.  The
  2109    exception is `font' attribute.  It is set to FONT_OBJECT regardless
  2110    of FORCE_P.  */
  2111 
  2112 static void
  2113 set_lface_from_font (struct frame *f, Lisp_Object lface,
  2114                      Lisp_Object font_object, bool force_p)
  2115 {
  2116   Lisp_Object val;
  2117   struct font *font = XFONT_OBJECT (font_object);
  2118 
  2119   /* Set attributes only if unspecified, otherwise face defaults for
  2120      new frames would never take effect.  If the font doesn't have a
  2121      specific property, set a normal value for that.  */
  2122 
  2123   if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
  2124     {
  2125       Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
  2126 
  2127       ASET (lface, LFACE_FAMILY_INDEX, SYMBOL_NAME (family));
  2128     }
  2129 
  2130   if (force_p || UNSPECIFIEDP (LFACE_FOUNDRY (lface)))
  2131     {
  2132       Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX);
  2133 
  2134       ASET (lface, LFACE_FOUNDRY_INDEX, SYMBOL_NAME (foundry));
  2135     }
  2136 
  2137   if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
  2138     {
  2139       int pt = PIXEL_TO_POINT (font->pixel_size * 10, FRAME_RES_Y (f));
  2140 
  2141       eassert (pt > 0);
  2142       ASET (lface, LFACE_HEIGHT_INDEX, make_fixnum (pt));
  2143     }
  2144 
  2145   if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
  2146     {
  2147       val = FONT_WEIGHT_FOR_FACE (font_object);
  2148       ASET (lface, LFACE_WEIGHT_INDEX, ! NILP (val) ? val :Qnormal);
  2149     }
  2150   if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
  2151     {
  2152       val = FONT_SLANT_FOR_FACE (font_object);
  2153       ASET (lface, LFACE_SLANT_INDEX, ! NILP (val) ? val : Qnormal);
  2154     }
  2155   if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
  2156     {
  2157       val = FONT_WIDTH_FOR_FACE (font_object);
  2158       ASET (lface, LFACE_SWIDTH_INDEX, ! NILP (val) ? val : Qnormal);
  2159     }
  2160 
  2161   ASET (lface, LFACE_FONT_INDEX, font_object);
  2162 }
  2163 
  2164 #endif /* HAVE_WINDOW_SYSTEM */
  2165 
  2166 
  2167 /* Merges the face height FROM with the face height TO, and returns the
  2168    merged height.  If FROM is an invalid height, then INVALID is
  2169    returned instead.  FROM and TO may be either absolute face heights or
  2170    `relative' heights; the returned value is always an absolute height
  2171    unless both FROM and TO are relative.  */
  2172 
  2173 static Lisp_Object
  2174 merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid)
  2175 {
  2176   Lisp_Object result = invalid;
  2177 
  2178   if (FIXNUMP (from))
  2179     /* FROM is absolute, just use it as is.  */
  2180     result = from;
  2181   else if (FLOATP (from))
  2182     /* FROM is a scale, use it to adjust TO.  */
  2183     {
  2184       if (FIXNUMP (to))
  2185         /* relative X absolute => absolute */
  2186         result = make_fixnum (XFLOAT_DATA (from) * XFIXNUM (to));
  2187       else if (FLOATP (to))
  2188         /* relative X relative => relative */
  2189         result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
  2190       else if (UNSPECIFIEDP (to))
  2191         result = from;
  2192     }
  2193   else if (FUNCTIONP (from))
  2194     /* FROM is a function, which use to adjust TO.  */
  2195     {
  2196       /* Call function with current height as argument.
  2197          From is the new height.  */
  2198       result = safe_call1 (from, to);
  2199 
  2200       /* Ensure that if TO was absolute, so is the result.  */
  2201       if (FIXNUMP (to) && !FIXNUMP (result))
  2202         result = invalid;
  2203     }
  2204 
  2205   return result;
  2206 }
  2207 
  2208 
  2209 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
  2210    store the resulting attributes in TO, which must be already be
  2211    completely specified and contain only absolute attributes.
  2212    Every specified attribute of FROM overrides the corresponding
  2213    attribute of TO; relative attributes in FROM are merged with the
  2214    absolute value in TO and replace it.  NAMED_MERGE_POINTS is used
  2215    internally to detect loops in face inheritance/remapping; it should
  2216    be 0 when called from other places.  If window W is non-NULL, use W
  2217    to interpret face specifications. */
  2218 static void
  2219 merge_face_vectors (struct window *w,
  2220                     struct frame *f, const Lisp_Object *from, Lisp_Object *to,
  2221                     struct named_merge_point *named_merge_points)
  2222 {
  2223   int i;
  2224   Lisp_Object font = Qnil;
  2225 
  2226   /* If FROM inherits from some other faces, merge their attributes into
  2227      TO before merging FROM's direct attributes.  Note that an :inherit
  2228      attribute of `unspecified' is the same as one of nil; we never
  2229      merge :inherit attributes, so nil is more correct, but lots of
  2230      other code uses `unspecified' as a generic value for face attributes. */
  2231   if (!UNSPECIFIEDP (from[LFACE_INHERIT_INDEX])
  2232       && !NILP (from[LFACE_INHERIT_INDEX]))
  2233     merge_face_ref (w, f, from[LFACE_INHERIT_INDEX],
  2234                     to, false, named_merge_points,
  2235                     0);
  2236 
  2237   if (FONT_SPEC_P (from[LFACE_FONT_INDEX]))
  2238     {
  2239       if (!UNSPECIFIEDP (to[LFACE_FONT_INDEX]))
  2240         font = merge_font_spec (from[LFACE_FONT_INDEX], to[LFACE_FONT_INDEX]);
  2241       else
  2242         font = copy_font_spec (from[LFACE_FONT_INDEX]);
  2243       to[LFACE_FONT_INDEX] = font;
  2244     }
  2245 
  2246   for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
  2247     if (!UNSPECIFIEDP (from[i]))
  2248       {
  2249         if (i == LFACE_HEIGHT_INDEX && !FIXNUMP (from[i]))
  2250           {
  2251             to[i] = merge_face_heights (from[i], to[i], to[i]);
  2252             font_clear_prop (to, FONT_SIZE_INDEX);
  2253           }
  2254         else if (i != LFACE_FONT_INDEX && ! EQ (to[i], from[i]))
  2255           {
  2256             to[i] = from[i];
  2257             if (i >= LFACE_FAMILY_INDEX && i <= LFACE_SLANT_INDEX)
  2258               font_clear_prop (to,
  2259                                (i == LFACE_FAMILY_INDEX ? FONT_FAMILY_INDEX
  2260                                 : i == LFACE_FOUNDRY_INDEX ? FONT_FOUNDRY_INDEX
  2261                                 : i == LFACE_SWIDTH_INDEX ? FONT_WIDTH_INDEX
  2262                                 : i == LFACE_HEIGHT_INDEX ? FONT_SIZE_INDEX
  2263                                 : i == LFACE_WEIGHT_INDEX ? FONT_WEIGHT_INDEX
  2264                                 : FONT_SLANT_INDEX));
  2265           }
  2266       }
  2267 
  2268   /* If FROM specifies a font spec, make its contents take precedence
  2269      over :family and other attributes.  This is needed for face
  2270      remapping using :font to work.  */
  2271 
  2272   if (!NILP (font))
  2273     {
  2274       if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
  2275         to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX));
  2276       if (! NILP (AREF (font, FONT_FAMILY_INDEX)))
  2277         to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX));
  2278       if (! NILP (AREF (font, FONT_WEIGHT_INDEX)))
  2279         to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (font);
  2280       if (! NILP (AREF (font, FONT_SLANT_INDEX)))
  2281         to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font);
  2282       if (! NILP (AREF (font, FONT_WIDTH_INDEX)))
  2283         to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font);
  2284       ASET (font, FONT_SIZE_INDEX, Qnil);
  2285     }
  2286 
  2287   /* TO is always an absolute face, which should inherit from nothing.
  2288      We blindly copy the :inherit attribute above and fix it up here.  */
  2289   to[LFACE_INHERIT_INDEX] = Qnil;
  2290 }
  2291 
  2292 /* Chase the chain of face inheritance of frame F's face whose
  2293    attributes are in ATTRS, for a non-'unspecified' value of face
  2294    attribute whose index is ATTR_IDX, and return that value.  Window
  2295    W, if non-NULL, is used to filter face specifications.  */
  2296 static Lisp_Object
  2297 face_inherited_attr (struct window *w, struct frame *f,
  2298                      Lisp_Object attrs[LFACE_VECTOR_SIZE],
  2299                      enum lface_attribute_index attr_idx,
  2300                      struct named_merge_point *named_merge_points)
  2301 {
  2302   Lisp_Object inherited_attrs[LFACE_VECTOR_SIZE];
  2303   Lisp_Object attr_val = attrs[attr_idx];
  2304 
  2305   memcpy (inherited_attrs, attrs, LFACE_VECTOR_SIZE * sizeof (attrs[0]));
  2306   while (UNSPECIFIEDP (attr_val)
  2307          && !NILP (inherited_attrs[LFACE_INHERIT_INDEX])
  2308          && !UNSPECIFIEDP (inherited_attrs[LFACE_INHERIT_INDEX]))
  2309     {
  2310       Lisp_Object parent_face = inherited_attrs[LFACE_INHERIT_INDEX];
  2311       bool ok;
  2312 
  2313       if (CONSP (parent_face))
  2314         {
  2315           Lisp_Object tail;
  2316           ok = false;
  2317           for (tail = parent_face; !NILP (tail); tail = XCDR (tail))
  2318             {
  2319               ok = get_lface_attributes (w, f, XCAR (tail), inherited_attrs,
  2320                                          false, named_merge_points);
  2321               if (!ok)
  2322                 break;
  2323               attr_val = face_inherited_attr (w, f, inherited_attrs, attr_idx,
  2324                                               named_merge_points);
  2325               if (!UNSPECIFIEDP (attr_val))
  2326                 break;
  2327             }
  2328           if (!ok)      /* bad face? */
  2329             break;
  2330         }
  2331       else
  2332         {
  2333           ok = get_lface_attributes (w, f, parent_face, inherited_attrs,
  2334                                      false, named_merge_points);
  2335           if (!ok)
  2336             break;
  2337           attr_val = inherited_attrs[attr_idx];
  2338         }
  2339     }
  2340   return attr_val;
  2341 }
  2342 
  2343 /* Merge the named face FACE_NAME on frame F, into the vector of face
  2344    attributes TO.  Use NAMED_MERGE_POINTS to detect loops in face
  2345    inheritance.  Return true if FACE_NAME is a valid face name and
  2346    merging succeeded.  Window W, if non-NULL, is used to filter face
  2347    specifications. */
  2348 
  2349 static bool
  2350 merge_named_face (struct window *w,
  2351                   struct frame *f, Lisp_Object face_name, Lisp_Object *to,
  2352                   struct named_merge_point *named_merge_points,
  2353                   enum lface_attribute_index attr_filter)
  2354 {
  2355   struct named_merge_point named_merge_point;
  2356 
  2357   if (push_named_merge_point (&named_merge_point,
  2358                               face_name, NAMED_MERGE_POINT_NORMAL,
  2359                               &named_merge_points))
  2360     {
  2361       Lisp_Object from[LFACE_VECTOR_SIZE], val;
  2362       bool ok = get_lface_attributes (w, f, face_name, from, false,
  2363                                       named_merge_points);
  2364       if (ok && !EQ (face_name, Qdefault))
  2365         {
  2366           struct face *deflt = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  2367           int i;
  2368           for (i = 1; i < LFACE_VECTOR_SIZE; i++)
  2369             if (EQ (from[i], Qreset))
  2370               from[i] = deflt->lface[i];
  2371         }
  2372 
  2373       if (ok && (attr_filter == 0              /* No filter.  */
  2374                  || (!NILP (from[attr_filter]) /* Filter, but specified.  */
  2375                      && !UNSPECIFIEDP (from[attr_filter]))
  2376                  /* Filter, unspecified, but inherited.  */
  2377                  || (!NILP (from[LFACE_INHERIT_INDEX])
  2378                      && !UNSPECIFIEDP (from[LFACE_INHERIT_INDEX])
  2379                      && (val = face_inherited_attr (w, f, from, attr_filter,
  2380                                                     named_merge_points),
  2381                          (!NILP (val) && !UNSPECIFIEDP (val))))))
  2382         merge_face_vectors (w, f, from, to, named_merge_points);
  2383 
  2384       return ok;
  2385     }
  2386   else
  2387     return false;
  2388 }
  2389 
  2390 /* Determine whether the face filter FILTER evaluated in window W
  2391    matches.  W can be NULL if the window context is unknown.
  2392 
  2393    A face filter is either nil, which always matches, or a list
  2394    (:window PARAMETER VALUE), which matches if the current window has
  2395    a PARAMETER EQ to VALUE.
  2396 
  2397    This function returns true if the face filter matches, and false if
  2398    it doesn't or if the function encountered an error.  If the filter
  2399    is invalid, set *OK to false and, if ERR_MSGS is true, log an error
  2400    message.  On success, *OK is untouched.  */
  2401 static bool
  2402 evaluate_face_filter (Lisp_Object filter, struct window *w,
  2403                       bool *ok, bool err_msgs)
  2404 {
  2405   Lisp_Object orig_filter = filter;
  2406 
  2407   /* Inner braces keep compiler happy about the goto skipping variable
  2408      initialization.  */
  2409   {
  2410     if (NILP (filter))
  2411       return true;
  2412 
  2413     if (face_filters_always_match)
  2414       return true;
  2415 
  2416     if (!CONSP (filter))
  2417       goto err;
  2418 
  2419     if (!EQ (XCAR (filter), QCwindow))
  2420       goto err;
  2421     filter = XCDR (filter);
  2422 
  2423     Lisp_Object parameter = XCAR (filter);
  2424     filter = XCDR (filter);
  2425     if (!CONSP (filter))
  2426       goto err;
  2427 
  2428     Lisp_Object value = XCAR (filter);
  2429     filter = XCDR (filter);
  2430     if (!NILP (filter))
  2431       goto err;
  2432 
  2433     bool match = false;
  2434     if (w)
  2435       {
  2436         Lisp_Object found = assq_no_quit (parameter, w->window_parameters);
  2437         if (!NILP (found) && EQ (XCDR (found), value))
  2438           match = true;
  2439       }
  2440 
  2441     return match;
  2442   }
  2443 
  2444  err:
  2445   if (err_msgs)
  2446     add_to_log ("Invalid face filter %S", orig_filter);
  2447   *ok = false;
  2448   return false;
  2449 }
  2450 
  2451 /* Determine whether FACE_REF is a "filter" face specification (case
  2452    #4 in merge_face_ref).  If it is, evaluate the filter, and if the
  2453    filter matches, return the filtered face spec.  If the filter does
  2454    not match, return nil.  If FACE_REF is not a filtered face
  2455    specification, return FACE_REF.
  2456 
  2457    On error, set *OK to false, having logged an error message if
  2458    ERR_MSGS is true, and return nil.  Otherwise, *OK is not touched.
  2459 
  2460    W is either NULL or a window used to evaluate filters.  If W is
  2461    NULL, no window-based face specification filter matches.
  2462 */
  2463 static Lisp_Object
  2464 filter_face_ref (Lisp_Object face_ref,
  2465                  struct window *w,
  2466                  bool *ok,
  2467                  bool err_msgs)
  2468 {
  2469   Lisp_Object orig_face_ref = face_ref;
  2470   if (!CONSP (face_ref))
  2471     return face_ref;
  2472 
  2473   /* Inner braces keep compiler happy about the goto skipping variable
  2474      initialization.  */
  2475   {
  2476     if (!EQ (XCAR (face_ref), QCfiltered))
  2477       return face_ref;
  2478     face_ref = XCDR (face_ref);
  2479 
  2480     if (!CONSP (face_ref))
  2481       goto err;
  2482     Lisp_Object filter = XCAR (face_ref);
  2483     face_ref = XCDR (face_ref);
  2484 
  2485     if (!CONSP (face_ref))
  2486       goto err;
  2487     Lisp_Object filtered_face_ref = XCAR (face_ref);
  2488     face_ref = XCDR (face_ref);
  2489 
  2490     if (!NILP (face_ref))
  2491       goto err;
  2492 
  2493     return evaluate_face_filter (filter, w, ok, err_msgs)
  2494       ? filtered_face_ref : Qnil;
  2495   }
  2496 
  2497  err:
  2498   if (err_msgs)
  2499     add_to_log ("Invalid face ref %S", orig_face_ref);
  2500   *ok = false;
  2501   return Qnil;
  2502 }
  2503 
  2504 /* Merge face attributes from the lisp `face reference' FACE_REF on
  2505    frame F into the face attribute vector TO as appropriate for
  2506    window W; W is used only for filtering face specs.  If ERR_MSGS
  2507    is non-zero, problems with FACE_REF cause an error message to be
  2508    shown.  Return true if no errors occurred (regardless of the value
  2509    of ERR_MSGS).  Use NAMED_MERGE_POINTS to detect loops in face
  2510    inheritance or list structure; it may be 0 for most callers.
  2511 
  2512    ATTR_FILTER is the index of a parameter that conditions the merging
  2513    for named faces (case 1) to only the face_ref where
  2514    lface[merge_face_ref] is non-nil.  To merge unconditionally set this
  2515    value to 0.
  2516 
  2517    FACE_REF may be a single face specification or a list of such
  2518    specifications.  Each face specification can be:
  2519 
  2520    1. A symbol or string naming a Lisp face.
  2521 
  2522    2. A property list of the form (KEYWORD VALUE ...) where each
  2523    KEYWORD is a face attribute name, and value is an appropriate value
  2524    for that attribute.
  2525 
  2526    3. Conses or the form (FOREGROUND-COLOR . COLOR) or
  2527    (BACKGROUND-COLOR . COLOR) where COLOR is a color name.  This is
  2528    for compatibility with 20.2.
  2529 
  2530    4. Conses of the form
  2531    (:filtered (:window PARAMETER VALUE) FACE-SPECIFICATION),
  2532    which applies FACE-SPECIFICATION only if the given face attributes
  2533    are being evaluated in the context of a window with a parameter
  2534    named PARAMETER being EQ VALUE.  In this case, W specifies the window
  2535    for which the filtered face spec is to be evaluated.
  2536 
  2537    5. nil, which means to merge nothing.
  2538 
  2539    Face specifications earlier in lists take precedence over later
  2540    specifications.  */
  2541 
  2542 static bool
  2543 merge_face_ref (struct window *w,
  2544                 struct frame *f, Lisp_Object face_ref, Lisp_Object *to,
  2545                 bool err_msgs, struct named_merge_point *named_merge_points,
  2546                 enum lface_attribute_index attr_filter)
  2547 {
  2548   bool ok = true;               /* Succeed without an error? */
  2549   Lisp_Object filtered_face_ref;
  2550   bool attr_filter_passed = false;
  2551 
  2552   filtered_face_ref = face_ref;
  2553   do
  2554     {
  2555       face_ref = filtered_face_ref;
  2556       filtered_face_ref = filter_face_ref (face_ref, w, &ok, err_msgs);
  2557     }
  2558   while (ok && !EQ (face_ref, filtered_face_ref));
  2559 
  2560   if (!ok)
  2561     return false;
  2562 
  2563   if (NILP (face_ref))
  2564     return true;
  2565 
  2566   if (CONSP (face_ref))
  2567     {
  2568       Lisp_Object first = XCAR (face_ref);
  2569 
  2570       if (EQ (first, Qforeground_color)
  2571           || EQ (first, Qbackground_color))
  2572         {
  2573           /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
  2574              . COLOR).  COLOR must be a string.  */
  2575           Lisp_Object color_name = XCDR (face_ref);
  2576           Lisp_Object color = first;
  2577 
  2578           if (STRINGP (color_name))
  2579             {
  2580               if (EQ (color, Qforeground_color))
  2581                 to[LFACE_FOREGROUND_INDEX] = color_name;
  2582               else
  2583                 to[LFACE_BACKGROUND_INDEX] = color_name;
  2584             }
  2585           else
  2586             {
  2587               if (err_msgs)
  2588                 add_to_log ("Invalid face color %S", color_name);
  2589               ok = false;
  2590             }
  2591         }
  2592       else if (SYMBOLP (first)
  2593                && *SDATA (SYMBOL_NAME (first)) == ':')
  2594         {
  2595           /* Assume this is the property list form.  */
  2596           if (attr_filter > 0)
  2597             {
  2598               eassert (attr_filter < LFACE_VECTOR_SIZE);
  2599               /* ATTR_FILTER positive means don't merge this face if
  2600                  the corresponding attribute is nil, or not mentioned,
  2601                  or if it's unspecified and the face doesn't inherit
  2602                  from a face whose attribute is non-nil.  The code
  2603                  below determines whether a face given as a property
  2604                  list shall be merged.  */
  2605               Lisp_Object parent_face = Qnil;
  2606               bool attr_filter_seen = false;
  2607               Lisp_Object face_ref_tem = face_ref;
  2608               while (CONSP (face_ref_tem) && CONSP (XCDR (face_ref_tem)))
  2609                 {
  2610                   Lisp_Object keyword = XCAR (face_ref_tem);
  2611                   Lisp_Object value = XCAR (XCDR (face_ref_tem));
  2612 
  2613                   if (EQ (keyword, face_attr_sym[attr_filter])
  2614                       || (attr_filter == LFACE_INVERSE_INDEX
  2615                           && EQ (keyword, QCreverse_video)))
  2616                     {
  2617                       attr_filter_seen = true;
  2618                       if (NILP (value))
  2619                         return true;
  2620                     }
  2621                   else if (EQ (keyword, QCinherit))
  2622                     parent_face = value;
  2623                   face_ref_tem = XCDR (XCDR (face_ref_tem));
  2624                 }
  2625               if (!attr_filter_seen)
  2626                 {
  2627                   if (NILP (parent_face))
  2628                     return true;
  2629 
  2630                   Lisp_Object scratch_attrs[LFACE_VECTOR_SIZE];
  2631                   int i;
  2632 
  2633                   scratch_attrs[0] = Qface;
  2634                   for (i = 1; i < LFACE_VECTOR_SIZE; i++)
  2635                     scratch_attrs[i] = Qunspecified;
  2636                   if (!merge_face_ref (w, f, parent_face, scratch_attrs,
  2637                                        err_msgs, named_merge_points, 0))
  2638                     {
  2639                       add_to_log ("Invalid face attribute %S %S",
  2640                                   QCinherit, parent_face);
  2641                       return false;
  2642                     }
  2643                   if (NILP (scratch_attrs[attr_filter])
  2644                       || UNSPECIFIEDP (scratch_attrs[attr_filter]))
  2645                     return true;
  2646                 }
  2647               attr_filter_passed = true;
  2648             }
  2649           while (CONSP (face_ref) && CONSP (XCDR (face_ref)))
  2650             {
  2651               Lisp_Object keyword = XCAR (face_ref);
  2652               Lisp_Object value = XCAR (XCDR (face_ref));
  2653               bool err = false;
  2654 
  2655               /* Specifying `unspecified' is a no-op.  */
  2656               if (EQ (value, Qunspecified))
  2657                 ;
  2658               else if (EQ (keyword, QCfamily))
  2659                 {
  2660                   if (STRINGP (value))
  2661                     {
  2662                       to[LFACE_FAMILY_INDEX] = value;
  2663                       font_clear_prop (to, FONT_FAMILY_INDEX);
  2664                     }
  2665                   else
  2666                     err = true;
  2667                 }
  2668               else if (EQ (keyword, QCfoundry))
  2669                 {
  2670                   if (STRINGP (value))
  2671                     {
  2672                       to[LFACE_FOUNDRY_INDEX] = value;
  2673                       font_clear_prop (to, FONT_FOUNDRY_INDEX);
  2674                     }
  2675                   else
  2676                     err = true;
  2677                 }
  2678               else if (EQ (keyword, QCheight))
  2679                 {
  2680                   Lisp_Object new_height =
  2681                     merge_face_heights (value, to[LFACE_HEIGHT_INDEX], Qnil);
  2682 
  2683                   if (! NILP (new_height))
  2684                     {
  2685                       to[LFACE_HEIGHT_INDEX] = new_height;
  2686                       font_clear_prop (to, FONT_SIZE_INDEX);
  2687                     }
  2688                   else
  2689                     err = true;
  2690                 }
  2691               else if (EQ (keyword, QCweight))
  2692                 {
  2693                   if (SYMBOLP (value) && FONT_WEIGHT_NAME_NUMERIC (value) >= 0)
  2694                     {
  2695                       to[LFACE_WEIGHT_INDEX] = value;
  2696                       font_clear_prop (to, FONT_WEIGHT_INDEX);
  2697                     }
  2698                   else
  2699                     err = true;
  2700                 }
  2701               else if (EQ (keyword, QCslant))
  2702                 {
  2703                   if (SYMBOLP (value) && FONT_SLANT_NAME_NUMERIC (value) >= 0)
  2704                     {
  2705                       to[LFACE_SLANT_INDEX] = value;
  2706                       font_clear_prop (to, FONT_SLANT_INDEX);
  2707                     }
  2708                   else
  2709                     err = true;
  2710                 }
  2711               else if (EQ (keyword, QCunderline))
  2712                 {
  2713                   if (EQ (value, Qt)
  2714                       || NILP (value)
  2715                       || STRINGP (value)
  2716                       || CONSP (value))
  2717                     to[LFACE_UNDERLINE_INDEX] = value;
  2718                   else
  2719                     err = true;
  2720                 }
  2721               else if (EQ (keyword, QCoverline))
  2722                 {
  2723                   if (EQ (value, Qt)
  2724                       || NILP (value)
  2725                       || STRINGP (value))
  2726                     to[LFACE_OVERLINE_INDEX] = value;
  2727                   else
  2728                     err = true;
  2729                 }
  2730               else if (EQ (keyword, QCstrike_through))
  2731                 {
  2732                   if (EQ (value, Qt)
  2733                       || NILP (value)
  2734                       || STRINGP (value))
  2735                     to[LFACE_STRIKE_THROUGH_INDEX] = value;
  2736                   else
  2737                     err = true;
  2738                 }
  2739               else if (EQ (keyword, QCbox))
  2740                 {
  2741                   if (EQ (value, Qt))
  2742                     value = make_fixnum (1);
  2743                   if ((FIXNUMP (value) && XFIXNUM (value) != 0)
  2744                       || STRINGP (value)
  2745                       || CONSP (value)
  2746                       || NILP (value))
  2747                     to[LFACE_BOX_INDEX] = value;
  2748                   else
  2749                     err = true;
  2750                 }
  2751               else if (EQ (keyword, QCinverse_video)
  2752                        || EQ (keyword, QCreverse_video))
  2753                 {
  2754                   if (EQ (value, Qt) || NILP (value))
  2755                     to[LFACE_INVERSE_INDEX] = value;
  2756                   else
  2757                     err = true;
  2758                 }
  2759               else if (EQ (keyword, QCforeground))
  2760                 {
  2761                   if (STRINGP (value))
  2762                     to[LFACE_FOREGROUND_INDEX] = value;
  2763                   else
  2764                     err = true;
  2765                 }
  2766               else if (EQ (keyword, QCdistant_foreground))
  2767                 {
  2768                   if (STRINGP (value))
  2769                     to[LFACE_DISTANT_FOREGROUND_INDEX] = value;
  2770                   else
  2771                     err = true;
  2772                 }
  2773               else if (EQ (keyword, QCbackground))
  2774                 {
  2775                   if (STRINGP (value))
  2776                     to[LFACE_BACKGROUND_INDEX] = value;
  2777                   else
  2778                     err = true;
  2779                 }
  2780               else if (EQ (keyword, QCstipple))
  2781                 {
  2782 #if defined (HAVE_WINDOW_SYSTEM)
  2783                   if (NILP (value) || !NILP (Fbitmap_spec_p (value)))
  2784                     to[LFACE_STIPPLE_INDEX] = value;
  2785                   else
  2786                     err = true;
  2787 #endif /* HAVE_WINDOW_SYSTEM */
  2788                 }
  2789               else if (EQ (keyword, QCwidth))
  2790                 {
  2791                   if (SYMBOLP (value) && FONT_WIDTH_NAME_NUMERIC (value) >= 0)
  2792                     {
  2793                       to[LFACE_SWIDTH_INDEX] = value;
  2794                       font_clear_prop (to, FONT_WIDTH_INDEX);
  2795                     }
  2796                   else
  2797                     err = true;
  2798                 }
  2799               else if (EQ (keyword, QCfont))
  2800                 {
  2801                   if (FONTP (value))
  2802                     to[LFACE_FONT_INDEX] = value;
  2803                   else
  2804                     err = true;
  2805                 }
  2806               else if (EQ (keyword, QCinherit))
  2807                 {
  2808                   /* This is not really very useful; it's just like a
  2809                      normal face reference.  */
  2810                   if (attr_filter_passed)
  2811                     {
  2812                       /* We already know that this face was tested
  2813                          against attr_filter and was found applicable,
  2814                          so don't pass attr_filter to merge_face_ref.
  2815                          This is for when a face is specified like
  2816                          (:inherit FACE :extend t), but the parent
  2817                          FACE itself doesn't specify :extend.  */
  2818                       if (! merge_face_ref (w, f, value, to,
  2819                                             err_msgs, named_merge_points, 0))
  2820                         err = true;
  2821                     }
  2822                   else if (! merge_face_ref (w, f, value, to,
  2823                                              err_msgs, named_merge_points,
  2824                                              attr_filter))
  2825                     err = true;
  2826                 }
  2827               else if (EQ (keyword, QCextend))
  2828                 {
  2829                   if (EQ (value, Qt) || NILP (value))
  2830                     to[LFACE_EXTEND_INDEX] = value;
  2831                   else
  2832                     err = true;
  2833                 }
  2834               else
  2835                 err = true;
  2836 
  2837               if (err)
  2838                 {
  2839                   add_to_log ("Invalid face attribute %S %S", keyword, value);
  2840                   ok = false;
  2841                 }
  2842 
  2843               face_ref = XCDR (XCDR (face_ref));
  2844             }
  2845         }
  2846       else
  2847         {
  2848           /* This is a list of face refs.  Those at the beginning of the
  2849              list take precedence over what follows, so we have to merge
  2850              from the end backwards.  */
  2851           Lisp_Object next = XCDR (face_ref);
  2852 
  2853           if (! NILP (next))
  2854             ok = merge_face_ref (w, f, next, to, err_msgs,
  2855                                  named_merge_points, attr_filter);
  2856 
  2857           if (! merge_face_ref (w, f, first, to, err_msgs,
  2858                                 named_merge_points, attr_filter))
  2859             ok = false;
  2860         }
  2861     }
  2862   else
  2863     {
  2864       /* FACE_REF ought to be a face name.  */
  2865       ok = merge_named_face (w, f, face_ref, to, named_merge_points,
  2866                              attr_filter);
  2867       if (!ok && err_msgs)
  2868         add_to_log ("Invalid face reference: %s", face_ref);
  2869     }
  2870 
  2871   return ok;
  2872 }
  2873 
  2874 
  2875 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
  2876        Sinternal_make_lisp_face, 1, 2, 0,
  2877        doc: /* Make FACE, a symbol, a Lisp face with all attributes nil.
  2878 If FACE was not known as a face before, create a new one.
  2879 If optional argument FRAME is specified, make a frame-local face
  2880 for that frame.  Otherwise operate on the global face definition.
  2881 Value is a vector of face attributes.  */)
  2882   (Lisp_Object face, Lisp_Object frame)
  2883 {
  2884   Lisp_Object global_lface, lface;
  2885   struct frame *f;
  2886   int i;
  2887 
  2888   CHECK_SYMBOL (face);
  2889   global_lface = lface_from_face_name (NULL, face, false);
  2890 
  2891   if (!NILP (frame))
  2892     {
  2893       CHECK_LIVE_FRAME (frame);
  2894       f = XFRAME (frame);
  2895       lface = lface_from_face_name (f, face, false);
  2896     }
  2897   else
  2898     f = NULL, lface = Qnil;
  2899 
  2900   /* Add a global definition if there is none.  */
  2901   if (NILP (global_lface))
  2902     {
  2903       /* Assign the new Lisp face a unique ID.  The mapping from Lisp
  2904          face id to Lisp face is given by the vector lface_id_to_name.
  2905          The mapping from Lisp face to Lisp face id is given by the
  2906          property `face' of the Lisp face name.  */
  2907       if (next_lface_id == lface_id_to_name_size)
  2908         lface_id_to_name =
  2909           xpalloc (lface_id_to_name, &lface_id_to_name_size, 1, MAX_FACE_ID,
  2910                    sizeof *lface_id_to_name);
  2911 
  2912       Lisp_Object face_id = make_fixnum (next_lface_id);
  2913       lface_id_to_name[next_lface_id] = face;
  2914       Fput (face, Qface, face_id);
  2915       ++next_lface_id;
  2916 
  2917       global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
  2918       ASET (global_lface, 0, Qface);
  2919       Fputhash (face, Fcons (face_id, global_lface), Vface_new_frame_defaults);
  2920     }
  2921   else if (f == NULL)
  2922     for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
  2923       ASET (global_lface, i, Qunspecified);
  2924 
  2925   /* Add a frame-local definition.  */
  2926   if (f)
  2927     {
  2928       if (NILP (lface))
  2929         {
  2930           lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
  2931           ASET (lface, 0, Qface);
  2932           Fputhash (face, lface, f->face_hash_table);
  2933         }
  2934       else
  2935         for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
  2936           ASET (lface, i, Qunspecified);
  2937     }
  2938   else
  2939     lface = global_lface;
  2940 
  2941   /* Changing a named face means that all realized faces depending on
  2942      that face are invalid.  Since we cannot tell which realized faces
  2943      depend on the face, make sure they are all removed.  This is done
  2944      by setting face_change.  The next call to init_iterator will then
  2945      free realized faces.  */
  2946   if (NILP (Fget (face, Qface_no_inherit)))
  2947     {
  2948       if (f)
  2949         {
  2950           f->face_change = true;
  2951           fset_redisplay (f);
  2952         }
  2953       else
  2954         {
  2955           face_change = true;
  2956           windows_or_buffers_changed = 54;
  2957         }
  2958     }
  2959 
  2960   eassert (LFACEP (lface));
  2961   check_lface (lface);
  2962   return lface;
  2963 }
  2964 
  2965 
  2966 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p,
  2967        Sinternal_lisp_face_p, 1, 2, 0,
  2968        doc: /* Return non-nil if FACE names a face.
  2969 FACE should be a symbol or string.
  2970 If optional second argument FRAME is non-nil, check for the
  2971 existence of a frame-local face with name FACE on that frame.
  2972 Otherwise check for the existence of a global face.  */)
  2973   (Lisp_Object face, Lisp_Object frame)
  2974 {
  2975   Lisp_Object lface;
  2976 
  2977   face = resolve_face_name (face, true);
  2978 
  2979   if (!NILP (frame))
  2980     {
  2981       CHECK_LIVE_FRAME (frame);
  2982       lface = lface_from_face_name (XFRAME (frame), face, false);
  2983     }
  2984   else
  2985     lface = lface_from_face_name (NULL, face, false);
  2986 
  2987   return lface;
  2988 }
  2989 
  2990 
  2991 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face,
  2992        Sinternal_copy_lisp_face, 4, 4, 0,
  2993        doc: /* Copy face FROM to TO.
  2994 If FRAME is t, copy the global face definition of FROM.
  2995 Otherwise, copy the frame-local definition of FROM on FRAME.
  2996 If NEW-FRAME is a frame, copy that data into the frame-local
  2997 definition of TO on NEW-FRAME.  If NEW-FRAME is nil,
  2998 FRAME controls where the data is copied to.
  2999 
  3000 The value is TO.  */)
  3001   (Lisp_Object from, Lisp_Object to, Lisp_Object frame, Lisp_Object new_frame)
  3002 {
  3003   Lisp_Object lface, copy;
  3004   struct frame *f;
  3005 
  3006   CHECK_SYMBOL (from);
  3007   CHECK_SYMBOL (to);
  3008 
  3009   if (EQ (frame, Qt))
  3010     {
  3011       /* Copy global definition of FROM.  We don't make copies of
  3012          strings etc. because 20.2 didn't do it either.  */
  3013       lface = lface_from_face_name (NULL, from, true);
  3014       copy = Finternal_make_lisp_face (to, Qnil);
  3015       f = NULL;
  3016     }
  3017   else
  3018     {
  3019       /* Copy frame-local definition of FROM.  */
  3020       if (NILP (new_frame))
  3021         new_frame = frame;
  3022       CHECK_LIVE_FRAME (frame);
  3023       CHECK_LIVE_FRAME (new_frame);
  3024       lface = lface_from_face_name (XFRAME (frame), from, true);
  3025       copy = Finternal_make_lisp_face (to, new_frame);
  3026       f = XFRAME (new_frame);
  3027     }
  3028 
  3029   vcopy (copy, 0, xvector_contents (lface), LFACE_VECTOR_SIZE);
  3030 
  3031   /* Changing a named face means that all realized faces depending on
  3032      that face are invalid.  Since we cannot tell which realized faces
  3033      depend on the face, make sure they are all removed.  This is done
  3034      by setting face_change.  The next call to init_iterator will then
  3035      free realized faces.  */
  3036   if (NILP (Fget (to, Qface_no_inherit)))
  3037     {
  3038       if (f)
  3039         {
  3040           f->face_change = true;
  3041           fset_redisplay (f);
  3042         }
  3043       else
  3044         {
  3045           face_change = true;
  3046           windows_or_buffers_changed = 55;
  3047         }
  3048     }
  3049 
  3050   return to;
  3051 }
  3052 
  3053 
  3054 #define HANDLE_INVALID_NIL_VALUE(A,F)                                   \
  3055   if (NILP (value))                                                     \
  3056     {                                                                   \
  3057       add_to_log ("Warning: setting attribute `%s' of face `%s': nil "  \
  3058                   "value is invalid, use `unspecified' instead.", A, F); \
  3059       /* Compatibility with 20.x.  */                                   \
  3060       value = Qunspecified;                                             \
  3061     }
  3062 
  3063 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
  3064        Sinternal_set_lisp_face_attribute, 3, 4, 0,
  3065        doc: /* Set attribute ATTR of FACE to VALUE.
  3066 FRAME being a frame means change the face on that frame.
  3067 FRAME nil means change the face of the selected frame.
  3068 FRAME t means change the default for new frames.
  3069 FRAME 0 means change the face on all frames, and change the default
  3070   for new frames.  */)
  3071   (Lisp_Object face, Lisp_Object attr, Lisp_Object value, Lisp_Object frame)
  3072 {
  3073   Lisp_Object lface;
  3074   Lisp_Object old_value = Qnil;
  3075   /* Set one of enum font_property_index (> 0) if ATTR is one of
  3076      font-related attributes other than QCfont and QCfontset.  */
  3077   enum font_property_index prop_index = 0;
  3078   struct frame *f;
  3079 
  3080   CHECK_SYMBOL (face);
  3081   CHECK_SYMBOL (attr);
  3082 
  3083   face = resolve_face_name (face, true);
  3084 
  3085   /* If FRAME is 0, change face on all frames, and change the
  3086      default for new frames.  */
  3087   if (FIXNUMP (frame) && XFIXNUM (frame) == 0)
  3088     {
  3089       Lisp_Object tail;
  3090       Finternal_set_lisp_face_attribute (face, attr, value, Qt);
  3091       FOR_EACH_FRAME (tail, frame)
  3092         Finternal_set_lisp_face_attribute (face, attr, value, frame);
  3093       return face;
  3094     }
  3095 
  3096   /* Set lface to the Lisp attribute vector of FACE.  */
  3097   if (EQ (frame, Qt))
  3098     {
  3099       f = NULL;
  3100       lface = lface_from_face_name (NULL, face, true);
  3101 
  3102       /* When updating face--new-frame-defaults, we put :ignore-defface
  3103          where the caller wants `unspecified'.  This forces the frame
  3104          defaults to ignore the defface value.  Otherwise, the defface
  3105          will take effect, which is generally not what is intended.
  3106          The value of that attribute will be inherited from some other
  3107          face during face merging.  See internal_merge_in_global_face. */
  3108       if (UNSPECIFIEDP (value))
  3109         value = QCignore_defface;
  3110     }
  3111   else
  3112     {
  3113       if (NILP (frame))
  3114         frame = selected_frame;
  3115 
  3116       CHECK_LIVE_FRAME (frame);
  3117       f = XFRAME (frame);
  3118 
  3119       lface = lface_from_face_name (f, face, false);
  3120 
  3121       /* If a frame-local face doesn't exist yet, create one.  */
  3122       if (NILP (lface))
  3123         lface = Finternal_make_lisp_face (face, frame);
  3124     }
  3125 
  3126   if (EQ (attr, QCfamily))
  3127     {
  3128       if (!UNSPECIFIEDP (value)
  3129           && !IGNORE_DEFFACE_P (value)
  3130           && !RESET_P (value))
  3131         {
  3132           CHECK_STRING (value);
  3133           if (SCHARS (value) == 0)
  3134             signal_error ("Invalid face family", value);
  3135         }
  3136       old_value = LFACE_FAMILY (lface);
  3137       ASET (lface, LFACE_FAMILY_INDEX, value);
  3138       prop_index = FONT_FAMILY_INDEX;
  3139     }
  3140   else if (EQ (attr, QCfoundry))
  3141     {
  3142       if (!UNSPECIFIEDP (value)
  3143           && !IGNORE_DEFFACE_P (value)
  3144           && !RESET_P (value))
  3145         {
  3146           CHECK_STRING (value);
  3147           if (SCHARS (value) == 0)
  3148             signal_error ("Invalid face foundry", value);
  3149         }
  3150       old_value = LFACE_FOUNDRY (lface);
  3151       ASET (lface, LFACE_FOUNDRY_INDEX, value);
  3152       prop_index = FONT_FOUNDRY_INDEX;
  3153     }
  3154   else if (EQ (attr, QCheight))
  3155     {
  3156       if (!UNSPECIFIEDP (value)
  3157           && !IGNORE_DEFFACE_P (value)
  3158           && !RESET_P (value))
  3159         {
  3160           if (EQ (face, Qdefault))
  3161             {
  3162               /* The default face must have an absolute size.  */
  3163               if (!FIXNUMP (value) || XFIXNUM (value) <= 0)
  3164                 signal_error ("Default face height not absolute and positive",
  3165                               value);
  3166             }
  3167           else
  3168             {
  3169               /* For non-default faces, do a test merge with a random
  3170                  height to see if VALUE's ok. */
  3171               Lisp_Object test = merge_face_heights (value,
  3172                                                      make_fixnum (10),
  3173                                                      Qnil);
  3174               if (!FIXNUMP (test) || XFIXNUM (test) <= 0)
  3175                 signal_error ("Face height does not produce a positive integer",
  3176                               value);
  3177             }
  3178         }
  3179 
  3180       old_value = LFACE_HEIGHT (lface);
  3181       ASET (lface, LFACE_HEIGHT_INDEX, value);
  3182       prop_index = FONT_SIZE_INDEX;
  3183     }
  3184   else if (EQ (attr, QCweight))
  3185     {
  3186       if (!UNSPECIFIEDP (value)
  3187           && !IGNORE_DEFFACE_P (value)
  3188           && !RESET_P (value))
  3189         {
  3190           CHECK_SYMBOL (value);
  3191           if (FONT_WEIGHT_NAME_NUMERIC (value) < 0)
  3192             signal_error ("Invalid face weight", value);
  3193         }
  3194       old_value = LFACE_WEIGHT (lface);
  3195       ASET (lface, LFACE_WEIGHT_INDEX, value);
  3196       prop_index = FONT_WEIGHT_INDEX;
  3197     }
  3198   else if (EQ (attr, QCslant))
  3199     {
  3200       if (!UNSPECIFIEDP (value)
  3201           && !IGNORE_DEFFACE_P (value)
  3202           && !RESET_P (value))
  3203         {
  3204           CHECK_SYMBOL (value);
  3205           if (FONT_SLANT_NAME_NUMERIC (value) < 0)
  3206             signal_error ("Invalid face slant", value);
  3207         }
  3208       old_value = LFACE_SLANT (lface);
  3209       ASET (lface, LFACE_SLANT_INDEX, value);
  3210       prop_index = FONT_SLANT_INDEX;
  3211     }
  3212   else if (EQ (attr, QCunderline))
  3213     {
  3214       bool valid_p = false;
  3215 
  3216       if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value) || RESET_P (value))
  3217         valid_p = true;
  3218       else if (NILP (value) || EQ (value, Qt))
  3219         valid_p = true;
  3220       else if (STRINGP (value) && SCHARS (value) > 0)
  3221         valid_p = true;
  3222       else if (CONSP (value))
  3223         {
  3224           Lisp_Object key, val, list;
  3225 
  3226           list = value;
  3227           /* FIXME?  This errs on the side of acceptance.  Eg it accepts:
  3228                (defface foo '((t :underline 'foo) "doc")
  3229              Maybe this is intentional, maybe it isn't.
  3230              Non-nil symbols other than t are not documented as being valid.
  3231              Eg compare with inverse-video, which explicitly rejects them.
  3232           */
  3233           valid_p = true;
  3234 
  3235           while (!NILP (CAR_SAFE (list)))
  3236             {
  3237               key = CAR_SAFE (list);
  3238               list = CDR_SAFE (list);
  3239               val = CAR_SAFE (list);
  3240               list = CDR_SAFE (list);
  3241 
  3242               if (NILP (key) || (NILP (val)
  3243                                  && !EQ (key, QCposition)))
  3244                 {
  3245                   valid_p = false;
  3246                   break;
  3247                 }
  3248 
  3249               else if (EQ (key, QCcolor)
  3250                        && !(EQ (val, Qforeground_color)
  3251                             || (STRINGP (val) && SCHARS (val) > 0)))
  3252                 {
  3253                   valid_p = false;
  3254                   break;
  3255                 }
  3256 
  3257               else if (EQ (key, QCstyle)
  3258                        && !(EQ (val, Qline) || EQ (val, Qwave)))
  3259                 {
  3260                   valid_p = false;
  3261                   break;
  3262                 }
  3263             }
  3264         }
  3265 
  3266       if (!valid_p)
  3267         signal_error ("Invalid face underline", value);
  3268 
  3269       old_value = LFACE_UNDERLINE (lface);
  3270       ASET (lface, LFACE_UNDERLINE_INDEX, value);
  3271     }
  3272   else if (EQ (attr, QCoverline))
  3273     {
  3274       if (!UNSPECIFIEDP (value)
  3275           && !IGNORE_DEFFACE_P (value)
  3276           && !RESET_P (value))
  3277         if ((SYMBOLP (value)
  3278              && !EQ (value, Qt)
  3279              && !NILP (value))
  3280             /* Overline color.  */
  3281             || (STRINGP (value)
  3282                 && SCHARS (value) == 0))
  3283           signal_error ("Invalid face overline", value);
  3284 
  3285       old_value = LFACE_OVERLINE (lface);
  3286       ASET (lface, LFACE_OVERLINE_INDEX, value);
  3287     }
  3288   else if (EQ (attr, QCstrike_through))
  3289     {
  3290       if (!UNSPECIFIEDP (value)
  3291           && !IGNORE_DEFFACE_P (value)
  3292           && !RESET_P (value))
  3293         if ((SYMBOLP (value)
  3294              && !EQ (value, Qt)
  3295              && !NILP (value))
  3296             /* Strike-through color.  */
  3297             || (STRINGP (value)
  3298                 && SCHARS (value) == 0))
  3299           signal_error ("Invalid face strike-through", value);
  3300 
  3301       old_value = LFACE_STRIKE_THROUGH (lface);
  3302       ASET (lface, LFACE_STRIKE_THROUGH_INDEX, value);
  3303     }
  3304   else if (EQ (attr, QCbox))
  3305     {
  3306       bool valid_p;
  3307 
  3308       /* Allow t meaning a simple box of width 1 in foreground color
  3309          of the face.  */
  3310       if (EQ (value, Qt))
  3311         value = make_fixnum (1);
  3312 
  3313       if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value) || RESET_P (value))
  3314         valid_p = true;
  3315       else if (NILP (value))
  3316         valid_p = true;
  3317       else if (FIXNUMP (value))
  3318         valid_p = XFIXNUM (value) != 0;
  3319       else if (STRINGP (value))
  3320         valid_p = SCHARS (value) > 0;
  3321       else if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR (value)))
  3322         valid_p = true;
  3323       else if (CONSP (value))
  3324         {
  3325           Lisp_Object tem;
  3326 
  3327           tem = value;
  3328           while (CONSP (tem))
  3329             {
  3330               Lisp_Object k, v;
  3331 
  3332               k = XCAR (tem);
  3333               tem = XCDR (tem);
  3334               if (!CONSP (tem))
  3335                 break;
  3336               v = XCAR (tem);
  3337               tem = XCDR (tem);
  3338 
  3339               if (EQ (k, QCline_width))
  3340                 {
  3341                   if ((!CONSP(v) || !FIXNUMP (XCAR (v)) || XFIXNUM (XCAR (v)) == 0
  3342                                  || !FIXNUMP (XCDR (v)) || XFIXNUM (XCDR (v)) == 0)
  3343                       && (!FIXNUMP (v) || XFIXNUM (v) == 0))
  3344                     break;
  3345                 }
  3346               else if (EQ (k, QCcolor))
  3347                 {
  3348                   if (!NILP (v) && (!STRINGP (v) || SCHARS (v) == 0))
  3349                     break;
  3350                 }
  3351               else if (EQ (k, QCstyle))
  3352                 {
  3353                   if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button)
  3354                       && !EQ(v, Qflat_button))
  3355                     break;
  3356                 }
  3357               else
  3358                 break;
  3359             }
  3360 
  3361           valid_p = NILP (tem);
  3362         }
  3363       else
  3364         valid_p = false;
  3365 
  3366       if (!valid_p)
  3367         signal_error ("Invalid face box", value);
  3368 
  3369       old_value = LFACE_BOX (lface);
  3370       ASET (lface, LFACE_BOX_INDEX, value);
  3371     }
  3372   else if (EQ (attr, QCinverse_video)
  3373            || EQ (attr, QCreverse_video))
  3374     {
  3375       if (!UNSPECIFIEDP (value)
  3376           && !IGNORE_DEFFACE_P (value)
  3377           && !RESET_P (value))
  3378         {
  3379           CHECK_SYMBOL (value);
  3380           if (!EQ (value, Qt) && !NILP (value))
  3381             signal_error ("Invalid inverse-video face attribute value", value);
  3382         }
  3383       old_value = LFACE_INVERSE (lface);
  3384       ASET (lface, LFACE_INVERSE_INDEX, value);
  3385     }
  3386   else if (EQ (attr, QCextend))
  3387     {
  3388       if (!UNSPECIFIEDP (value)
  3389           && !IGNORE_DEFFACE_P (value)
  3390           && !RESET_P (value))
  3391         {
  3392           CHECK_SYMBOL (value);
  3393           if (!EQ (value, Qt) && !NILP (value))
  3394             signal_error ("Invalid extend face attribute value", value);
  3395         }
  3396       old_value = LFACE_EXTEND (lface);
  3397       ASET (lface, LFACE_EXTEND_INDEX, value);
  3398     }
  3399   else if (EQ (attr, QCforeground))
  3400     {
  3401       HANDLE_INVALID_NIL_VALUE (QCforeground, face);
  3402       if (!UNSPECIFIEDP (value)
  3403           && !IGNORE_DEFFACE_P (value)
  3404           && !RESET_P (value))
  3405         {
  3406           /* Don't check for valid color names here because it depends
  3407              on the frame (display) whether the color will be valid
  3408              when the face is realized.  */
  3409           CHECK_STRING (value);
  3410           if (SCHARS (value) == 0)
  3411             signal_error ("Empty foreground color value", value);
  3412         }
  3413       old_value = LFACE_FOREGROUND (lface);
  3414       ASET (lface, LFACE_FOREGROUND_INDEX, value);
  3415     }
  3416   else if (EQ (attr, QCdistant_foreground))
  3417     {
  3418       HANDLE_INVALID_NIL_VALUE (QCdistant_foreground, face);
  3419       if (!UNSPECIFIEDP (value)
  3420           && !IGNORE_DEFFACE_P (value)
  3421           && !RESET_P (value))
  3422         {
  3423           /* Don't check for valid color names here because it depends
  3424              on the frame (display) whether the color will be valid
  3425              when the face is realized.  */
  3426           CHECK_STRING (value);
  3427           if (SCHARS (value) == 0)
  3428             signal_error ("Empty distant-foreground color value", value);
  3429         }
  3430       old_value = LFACE_DISTANT_FOREGROUND (lface);
  3431       ASET (lface, LFACE_DISTANT_FOREGROUND_INDEX, value);
  3432     }
  3433   else if (EQ (attr, QCbackground))
  3434     {
  3435       HANDLE_INVALID_NIL_VALUE (QCbackground, face);
  3436       if (!UNSPECIFIEDP (value)
  3437           && !IGNORE_DEFFACE_P (value)
  3438           && !RESET_P (value))
  3439         {
  3440           /* Don't check for valid color names here because it depends
  3441              on the frame (display) whether the color will be valid
  3442              when the face is realized.  */
  3443           CHECK_STRING (value);
  3444           if (SCHARS (value) == 0)
  3445             signal_error ("Empty background color value", value);
  3446         }
  3447       old_value = LFACE_BACKGROUND (lface);
  3448       ASET (lface, LFACE_BACKGROUND_INDEX, value);
  3449     }
  3450   else if (EQ (attr, QCstipple))
  3451     {
  3452 #if defined (HAVE_WINDOW_SYSTEM)
  3453       if (!UNSPECIFIEDP (value)
  3454           && !IGNORE_DEFFACE_P (value)
  3455           && !RESET_P (value)
  3456           && !NILP (value)
  3457           && NILP (Fbitmap_spec_p (value)))
  3458         signal_error ("Invalid stipple attribute", value);
  3459       old_value = LFACE_STIPPLE (lface);
  3460       ASET (lface, LFACE_STIPPLE_INDEX, value);
  3461 #endif /* HAVE_WINDOW_SYSTEM */
  3462     }
  3463   else if (EQ (attr, QCwidth))
  3464     {
  3465       if (!UNSPECIFIEDP (value)
  3466           && !IGNORE_DEFFACE_P (value)
  3467           && !RESET_P (value))
  3468         {
  3469           CHECK_SYMBOL (value);
  3470           if (FONT_WIDTH_NAME_NUMERIC (value) < 0)
  3471             signal_error ("Invalid face width", value);
  3472         }
  3473       old_value = LFACE_SWIDTH (lface);
  3474       ASET (lface, LFACE_SWIDTH_INDEX, value);
  3475       prop_index = FONT_WIDTH_INDEX;
  3476     }
  3477   else if (EQ (attr, QCfont))
  3478     {
  3479 #ifdef HAVE_WINDOW_SYSTEM
  3480       if (EQ (frame, Qt) || FRAME_WINDOW_P (f))
  3481         {
  3482           if (!UNSPECIFIEDP (value)
  3483               && !IGNORE_DEFFACE_P (value)
  3484               && !RESET_P (value))
  3485             {
  3486               struct frame *f1;
  3487 
  3488               old_value = LFACE_FONT (lface);
  3489               if (! FONTP (value))
  3490                 {
  3491                   if (STRINGP (value))
  3492                     {
  3493                       Lisp_Object name = value;
  3494                       int fontset = fs_query_fontset (name, 0);
  3495 
  3496                       if (fontset >= 0)
  3497                         name = fontset_ascii (fontset);
  3498                       value = font_spec_from_name (name);
  3499                       if (!FONTP (value))
  3500                         signal_error ("Invalid font name", name);
  3501                     }
  3502                   else
  3503                     signal_error ("Invalid font or font-spec", value);
  3504                 }
  3505               if (EQ (frame, Qt))
  3506                 f1 = XFRAME (selected_frame);
  3507               else
  3508                 f1 = XFRAME (frame);
  3509 
  3510               /* FIXME:
  3511                  If frame is t, and selected frame is a tty frame, the font
  3512                  can't be realized.  An improvement would be to loop over frames
  3513                  for a non-tty frame and use that.  See discussion in Bug#18573.
  3514                  For a daemon, frame may be an initial frame (Bug#18869).  */
  3515               if (FRAME_WINDOW_P (f1))
  3516                 {
  3517                   if (! FONT_OBJECT_P (value))
  3518                     {
  3519                       Lisp_Object *attrs = XVECTOR (lface)->contents;
  3520                       Lisp_Object font_object;
  3521 
  3522                       font_object = font_load_for_lface (f1, attrs, value);
  3523                       if (NILP (font_object))
  3524                         signal_error ("Font not available", value);
  3525                       value = font_object;
  3526                     }
  3527                   set_lface_from_font (f1, lface, value, true);
  3528                   f1->face_change = 1;
  3529                 }
  3530             }
  3531           else
  3532             ASET (lface, LFACE_FONT_INDEX, value);
  3533         }
  3534 #endif /* HAVE_WINDOW_SYSTEM */
  3535     }
  3536   else if (EQ (attr, QCfontset))
  3537     {
  3538 #ifdef HAVE_WINDOW_SYSTEM
  3539       if (EQ (frame, Qt) || FRAME_WINDOW_P (f))
  3540         {
  3541           Lisp_Object tmp = value;
  3542 
  3543           old_value = LFACE_FONTSET (lface);
  3544           if (!RESET_P (value))
  3545             {
  3546               tmp = Fquery_fontset (value, Qnil);
  3547               if (NILP (tmp))
  3548                 signal_error ("Invalid fontset name", value);
  3549             }
  3550           ASET (lface, LFACE_FONTSET_INDEX, value = tmp);
  3551         }
  3552 #endif /* HAVE_WINDOW_SYSTEM */
  3553     }
  3554   else if (EQ (attr, QCinherit))
  3555     {
  3556       Lisp_Object tail;
  3557       if (SYMBOLP (value))
  3558         tail = Qnil;
  3559       else
  3560         for (tail = value; CONSP (tail); tail = XCDR (tail))
  3561           if (!SYMBOLP (XCAR (tail)))
  3562             break;
  3563       if (NILP (tail))
  3564         ASET (lface, LFACE_INHERIT_INDEX, value);
  3565       else
  3566         signal_error ("Invalid face inheritance", value);
  3567     }
  3568   else if (EQ (attr, QCbold))
  3569     {
  3570       old_value = LFACE_WEIGHT (lface);
  3571       if (RESET_P (value))
  3572         ASET (lface, LFACE_WEIGHT_INDEX, value);
  3573       else
  3574         ASET (lface, LFACE_WEIGHT_INDEX, NILP (value) ? Qnormal : Qbold);
  3575       prop_index = FONT_WEIGHT_INDEX;
  3576     }
  3577   else if (EQ (attr, QCitalic))
  3578     {
  3579       attr = QCslant;
  3580       old_value = LFACE_SLANT (lface);
  3581       if (RESET_P (value))
  3582         ASET (lface, LFACE_SLANT_INDEX, value);
  3583       else
  3584         ASET (lface, LFACE_SLANT_INDEX, NILP (value) ? Qnormal : Qitalic);
  3585       prop_index = FONT_SLANT_INDEX;
  3586     }
  3587   else
  3588     signal_error ("Invalid face attribute name", attr);
  3589 
  3590   if (prop_index)
  3591     {
  3592       /* If a font-related attribute other than QCfont and QCfontset
  3593          is specified, and if the original QCfont attribute has a font
  3594          (font-spec or font-object), set the corresponding property in
  3595          the font to nil so that the font selector doesn't think that
  3596          the attribute is mandatory.  Also, clear the average
  3597          width.  */
  3598       font_clear_prop (XVECTOR (lface)->contents, prop_index);
  3599     }
  3600 
  3601   /* Changing a named face means that all realized faces depending on
  3602      that face are invalid.  Since we cannot tell which realized faces
  3603      depend on the face, make sure they are all removed.  This is done
  3604      by setting face_change.  The next call to init_iterator will then
  3605      free realized faces.  */
  3606   if (!EQ (frame, Qt)
  3607       && NILP (Fget (face, Qface_no_inherit))
  3608       && NILP (Fequal (old_value, value)))
  3609     {
  3610       f->face_change = true;
  3611       fset_redisplay (f);
  3612     }
  3613 
  3614   if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
  3615       && NILP (Fequal (old_value, value)))
  3616     {
  3617       Lisp_Object param;
  3618 
  3619       param = Qnil;
  3620 
  3621       if (EQ (face, Qdefault))
  3622         {
  3623 #ifdef HAVE_WINDOW_SYSTEM
  3624           /* Changed font-related attributes of the `default' face are
  3625              reflected in changed `font' frame parameters.  */
  3626           if (FRAMEP (frame)
  3627               && (prop_index || EQ (attr, QCfont))
  3628               && lface_fully_specified_p (XVECTOR (lface)->contents))
  3629             set_font_frame_param (frame, lface);
  3630           else
  3631 #endif /* HAVE_WINDOW_SYSTEM */
  3632 
  3633           if (EQ (attr, QCforeground))
  3634             param = Qforeground_color;
  3635           else if (EQ (attr, QCbackground))
  3636             param = Qbackground_color;
  3637         }
  3638 #ifdef HAVE_WINDOW_SYSTEM
  3639 #ifndef HAVE_NTGUI
  3640       else if (EQ (face, Qscroll_bar))
  3641         {
  3642           /* Changing the colors of `scroll-bar' sets frame parameters
  3643              `scroll-bar-foreground' and `scroll-bar-background'. */
  3644           if (EQ (attr, QCforeground))
  3645             param = Qscroll_bar_foreground;
  3646           else if (EQ (attr, QCbackground))
  3647             param = Qscroll_bar_background;
  3648         }
  3649 #endif /* not HAVE_NTGUI */
  3650       else if (EQ (face, Qborder))
  3651         {
  3652           /* Changing background color of `border' sets frame parameter
  3653              `border-color'.  */
  3654           if (EQ (attr, QCbackground))
  3655             param = Qborder_color;
  3656         }
  3657       else if (EQ (face, Qcursor))
  3658         {
  3659           /* Changing background color of `cursor' sets frame parameter
  3660              `cursor-color'.  */
  3661           if (EQ (attr, QCbackground))
  3662             param = Qcursor_color;
  3663         }
  3664       else if (EQ (face, Qmouse))
  3665         {
  3666           /* Changing background color of `mouse' sets frame parameter
  3667              `mouse-color'.  */
  3668           if (EQ (attr, QCbackground))
  3669             param = Qmouse_color;
  3670         }
  3671 #endif /* HAVE_WINDOW_SYSTEM */
  3672       else if (EQ (face, Qmenu))
  3673         {
  3674           /* Indicate that we have to update the menu bar when realizing
  3675              faces on FRAME.  FRAME t change the default for new frames.
  3676              We do this by setting the flag in new face caches.  */
  3677           if (FRAMEP (frame))
  3678             {
  3679               struct frame *f = XFRAME (frame);
  3680               if (FRAME_FACE_CACHE (f) == NULL)
  3681                 FRAME_FACE_CACHE (f) = make_face_cache (f);
  3682               FRAME_FACE_CACHE (f)->menu_face_changed_p = true;
  3683             }
  3684           else
  3685             menu_face_changed_default = true;
  3686         }
  3687 
  3688       if (!NILP (param))
  3689         {
  3690           if (EQ (frame, Qt))
  3691             /* Update `default-frame-alist', which is used for new frames.  */
  3692             {
  3693               store_in_alist (&Vdefault_frame_alist, param, value);
  3694             }
  3695           else
  3696             /* Update the current frame's parameters.  */
  3697             {
  3698               AUTO_FRAME_ARG (arg, param, value);
  3699               Fmodify_frame_parameters (frame, arg);
  3700             }
  3701         }
  3702     }
  3703 
  3704   return face;
  3705 }
  3706 
  3707 
  3708 /* Update the corresponding face when frame parameter PARAM on frame F
  3709    has been assigned the value NEW_VALUE.  */
  3710 
  3711 void
  3712 update_face_from_frame_parameter (struct frame *f, Lisp_Object param,
  3713                                   Lisp_Object new_value)
  3714 {
  3715   Lisp_Object face = Qnil;
  3716   Lisp_Object lface;
  3717 
  3718   /* If there are no faces yet, give up.  This is the case when called
  3719      from Fx_create_frame, and we do the necessary things later in
  3720      face-set-after-frame-defaults.  */
  3721   if (XFIXNAT (Fhash_table_count (f->face_hash_table)) == 0)
  3722     return;
  3723 
  3724   if (EQ (param, Qforeground_color))
  3725     {
  3726       face = Qdefault;
  3727       lface = lface_from_face_name (f, face, true);
  3728       ASET (lface, LFACE_FOREGROUND_INDEX,
  3729             (STRINGP (new_value) ? new_value : Qunspecified));
  3730       realize_basic_faces (f);
  3731     }
  3732   else if (EQ (param, Qbackground_color))
  3733     {
  3734       Lisp_Object frame;
  3735 
  3736       /* Changing the background color might change the background
  3737          mode, so that we have to load new defface specs.
  3738          Call frame-set-background-mode to do that.  */
  3739       XSETFRAME (frame, f);
  3740       call1 (Qframe_set_background_mode, frame);
  3741 
  3742       face = Qdefault;
  3743       lface = lface_from_face_name (f, face, true);
  3744       ASET (lface, LFACE_BACKGROUND_INDEX,
  3745             (STRINGP (new_value) ? new_value : Qunspecified));
  3746       realize_basic_faces (f);
  3747     }
  3748 #ifdef HAVE_WINDOW_SYSTEM
  3749   else if (EQ (param, Qborder_color))
  3750     {
  3751       face = Qborder;
  3752       lface = lface_from_face_name (f, face, true);
  3753       ASET (lface, LFACE_BACKGROUND_INDEX,
  3754             (STRINGP (new_value) ? new_value : Qunspecified));
  3755     }
  3756   else if (EQ (param, Qcursor_color))
  3757     {
  3758       face = Qcursor;
  3759       lface = lface_from_face_name (f, face, true);
  3760       ASET (lface, LFACE_BACKGROUND_INDEX,
  3761             (STRINGP (new_value) ? new_value : Qunspecified));
  3762     }
  3763   else if (EQ (param, Qmouse_color))
  3764     {
  3765       face = Qmouse;
  3766       lface = lface_from_face_name (f, face, true);
  3767       ASET (lface, LFACE_BACKGROUND_INDEX,
  3768             (STRINGP (new_value) ? new_value : Qunspecified));
  3769     }
  3770 #endif
  3771 
  3772   /* Changing a named face means that all realized faces depending on
  3773      that face are invalid.  Since we cannot tell which realized faces
  3774      depend on the face, make sure they are all removed.  This is done
  3775      by setting face_change.  The next call to init_iterator will then
  3776      free realized faces.  */
  3777   if (!NILP (face)
  3778       && NILP (Fget (face, Qface_no_inherit)))
  3779     {
  3780       f->face_change = true;
  3781       fset_redisplay (f);
  3782     }
  3783 }
  3784 
  3785 
  3786 #ifdef HAVE_WINDOW_SYSTEM
  3787 
  3788 /* Set the `font' frame parameter of FRAME determined from the
  3789    font-object set in `default' face attributes LFACE.  */
  3790 
  3791 static void
  3792 set_font_frame_param (Lisp_Object frame, Lisp_Object lface)
  3793 {
  3794   struct frame *f = XFRAME (frame);
  3795   Lisp_Object font;
  3796 
  3797   if (FRAME_WINDOW_P (f)
  3798       /* Don't do anything if the font is `unspecified'.  This can
  3799          happen during frame creation.  */
  3800       && (font = LFACE_FONT (lface),
  3801           ! UNSPECIFIEDP (font)))
  3802     {
  3803       if (FONT_SPEC_P (font))
  3804         {
  3805           font = font_load_for_lface (f, XVECTOR (lface)->contents, font);
  3806           if (NILP (font))
  3807             return;
  3808           ASET (lface, LFACE_FONT_INDEX, font);
  3809         }
  3810       f->default_face_done_p = false;
  3811       AUTO_LIST2 (arg, AUTO_CONS_EXPR (Qfont, font),
  3812                   /* Clear the `font-parameter' frame property, as the
  3813                      font is now being specified by a face, not a
  3814                      frame property.  */
  3815                   AUTO_CONS_EXPR (Qfont_parameter, Qnil));
  3816       gui_set_frame_parameters_1 (f, arg, true);
  3817     }
  3818 }
  3819 
  3820 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
  3821        Sinternal_face_x_get_resource, 2, 3, 0,
  3822        doc: /* Get the value of X resource RESOURCE, class CLASS.
  3823 Returned value is for the display of frame FRAME.  If FRAME is not
  3824 specified or nil, use selected frame.  This function exists because
  3825 ordinary `x-get-resource' doesn't take a frame argument.  */)
  3826   (Lisp_Object resource, Lisp_Object class, Lisp_Object frame)
  3827 {
  3828   Lisp_Object value = Qnil;
  3829   struct frame *f;
  3830 
  3831   CHECK_STRING (resource);
  3832   CHECK_STRING (class);
  3833   f = decode_live_frame (frame);
  3834   block_input ();
  3835   value = gui_display_get_resource (FRAME_DISPLAY_INFO (f),
  3836                                     resource, class, Qnil, Qnil);
  3837   unblock_input ();
  3838   return value;
  3839 }
  3840 
  3841 
  3842 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
  3843    If VALUE is "on" or "true", return t.  If VALUE is "off" or
  3844    "false", return nil.  Otherwise, if SIGNAL_P, signal an
  3845    error; if !SIGNAL_P, return 0.  */
  3846 
  3847 static Lisp_Object
  3848 face_boolean_x_resource_value (Lisp_Object value, bool signal_p)
  3849 {
  3850   Lisp_Object result = make_fixnum (0);
  3851 
  3852   eassert (STRINGP (value));
  3853 
  3854   if (xstrcasecmp (SSDATA (value), "on") == 0
  3855       || xstrcasecmp (SSDATA (value), "true") == 0)
  3856     result = Qt;
  3857   else if (xstrcasecmp (SSDATA (value), "off") == 0
  3858            || xstrcasecmp (SSDATA (value), "false") == 0)
  3859     result = Qnil;
  3860   else if (xstrcasecmp (SSDATA (value), "unspecified") == 0)
  3861     result = Qunspecified;
  3862   else if (signal_p)
  3863     signal_error ("Invalid face attribute value from X resource", value);
  3864 
  3865   return result;
  3866 }
  3867 
  3868 
  3869 DEFUN ("internal-set-lisp-face-attribute-from-resource",
  3870        Finternal_set_lisp_face_attribute_from_resource,
  3871        Sinternal_set_lisp_face_attribute_from_resource,
  3872        3, 4, 0, doc: /* */)
  3873   (Lisp_Object face, Lisp_Object attr, Lisp_Object value, Lisp_Object frame)
  3874 {
  3875   CHECK_SYMBOL (face);
  3876   CHECK_SYMBOL (attr);
  3877   CHECK_STRING (value);
  3878 
  3879   if (xstrcasecmp (SSDATA (value), "unspecified") == 0)
  3880     value = Qunspecified;
  3881   else if (EQ (attr, QCheight))
  3882     {
  3883       value = Fstring_to_number (value, Qnil);
  3884       if (!FIXNUMP (value) || XFIXNUM (value) <= 0)
  3885         signal_error ("Invalid face height from X resource", value);
  3886     }
  3887   else if (EQ (attr, QCbold) || EQ (attr, QCitalic))
  3888     value = face_boolean_x_resource_value (value, true);
  3889   else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth))
  3890     value = intern (SSDATA (value));
  3891   else if (EQ (attr, QCreverse_video)
  3892            || EQ (attr, QCinverse_video)
  3893            || EQ (attr, QCextend))
  3894     value = face_boolean_x_resource_value (value, true);
  3895   else if (EQ (attr, QCunderline)
  3896            || EQ (attr, QCoverline)
  3897            || EQ (attr, QCstrike_through))
  3898     {
  3899       Lisp_Object boolean_value;
  3900 
  3901       /* If the result of face_boolean_x_resource_value is t or nil,
  3902          VALUE does NOT specify a color. */
  3903       boolean_value = face_boolean_x_resource_value (value, false);
  3904       if (SYMBOLP (boolean_value))
  3905         value = boolean_value;
  3906     }
  3907   else if (EQ (attr, QCbox) || EQ (attr, QCinherit))
  3908     value = Fcar (Fread_from_string (value, Qnil, Qnil));
  3909 
  3910   return Finternal_set_lisp_face_attribute (face, attr, value, frame);
  3911 }
  3912 
  3913 #endif /* HAVE_WINDOW_SYSTEM */
  3914 
  3915 
  3916 /***********************************************************************
  3917                               Menu face
  3918  ***********************************************************************/
  3919 
  3920 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
  3921 
  3922 /* Make menus on frame F appear as specified by the `menu' face.  */
  3923 
  3924 static void
  3925 x_update_menu_appearance (struct frame *f)
  3926 {
  3927   struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
  3928   XrmDatabase rdb;
  3929 
  3930   if (dpyinfo
  3931       && (rdb = XrmGetDatabase (FRAME_X_DISPLAY (f)),
  3932           rdb != NULL))
  3933     {
  3934       char line[512];
  3935       char *buf = line;
  3936       ptrdiff_t bufsize = sizeof line;
  3937       Lisp_Object lface = lface_from_face_name (f, Qmenu, true);
  3938       struct face *face = FACE_FROM_ID (f, MENU_FACE_ID);
  3939       const char *myname = SSDATA (Vx_resource_name);
  3940       bool changed_p = false;
  3941 #ifdef USE_MOTIF
  3942       const char *popup_path = "popup_menu";
  3943 #else
  3944       const char *popup_path = "menu.popup";
  3945 #endif
  3946 
  3947       if (STRINGP (LFACE_FOREGROUND (lface)))
  3948         {
  3949           exprintf (&buf, &bufsize, line, -1, "%s.%s*foreground: %s",
  3950                     myname, popup_path,
  3951                     SDATA (LFACE_FOREGROUND (lface)));
  3952           XrmPutLineResource (&rdb, line);
  3953           exprintf (&buf, &bufsize, line, -1, "%s.pane.menubar*foreground: %s",
  3954                     myname, SDATA (LFACE_FOREGROUND (lface)));
  3955           XrmPutLineResource (&rdb, line);
  3956           changed_p = true;
  3957         }
  3958 
  3959       if (STRINGP (LFACE_BACKGROUND (lface)))
  3960         {
  3961           exprintf (&buf, &bufsize, line, -1, "%s.%s*background: %s",
  3962                     myname, popup_path,
  3963                     SDATA (LFACE_BACKGROUND (lface)));
  3964           XrmPutLineResource (&rdb, line);
  3965 
  3966           exprintf (&buf, &bufsize, line, -1, "%s.pane.menubar*background: %s",
  3967                     myname, SDATA (LFACE_BACKGROUND (lface)));
  3968           XrmPutLineResource (&rdb, line);
  3969           changed_p = true;
  3970         }
  3971 
  3972       if (face->font
  3973           /* On Solaris 5.8, it's been reported that the `menu' face
  3974              can be unspecified here, during startup.  Why this
  3975              happens remains unknown.  -- cyd  */
  3976           && FONTP (LFACE_FONT (lface))
  3977           && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
  3978               || !UNSPECIFIEDP (LFACE_FOUNDRY (lface))
  3979               || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
  3980               || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
  3981               || !UNSPECIFIEDP (LFACE_SLANT (lface))
  3982               || !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
  3983         {
  3984           Lisp_Object xlfd = Ffont_xlfd_name (LFACE_FONT (lface), Qnil);
  3985 #ifdef USE_MOTIF
  3986           const char *suffix = "List";
  3987           bool motif = true;
  3988 #else
  3989 #if defined HAVE_X_I18N
  3990 
  3991           const char *suffix = "Set";
  3992 #else
  3993           const char *suffix = "";
  3994 #endif
  3995           bool motif = false;
  3996 #endif
  3997 
  3998           if (! NILP (xlfd))
  3999             {
  4000 #if defined HAVE_X_I18N
  4001               char *fontsetname = xic_create_fontsetname (SSDATA (xlfd), motif);
  4002 #else
  4003               char *fontsetname = SSDATA (xlfd);
  4004 #endif
  4005               exprintf (&buf, &bufsize, line, -1, "%s.pane.menubar*font%s: %s",
  4006                         myname, suffix, fontsetname);
  4007               XrmPutLineResource (&rdb, line);
  4008 
  4009               exprintf (&buf, &bufsize, line, -1, "%s.%s*font%s: %s",
  4010                         myname, popup_path, suffix, fontsetname);
  4011               XrmPutLineResource (&rdb, line);
  4012               changed_p = true;
  4013               if (fontsetname != SSDATA (xlfd))
  4014                 xfree (fontsetname);
  4015             }
  4016         }
  4017 
  4018       if (changed_p && f->output_data.x->menubar_widget)
  4019         free_frame_menubar (f);
  4020 
  4021       if (buf != line)
  4022         xfree (buf);
  4023     }
  4024 }
  4025 
  4026 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
  4027 
  4028 
  4029 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
  4030        Sface_attribute_relative_p,
  4031        2, 2, 0,
  4032        doc: /* Check whether a face attribute value is relative.
  4033 Specifically, this function returns t if the attribute ATTRIBUTE
  4034 with the value VALUE is relative.
  4035 
  4036 A relative value is one that doesn't entirely override whatever is
  4037 inherited from another face.  For most possible attributes,
  4038 the only relative value that users see is `unspecified'.
  4039 However, for :height, floating point values are also relative.  */
  4040        attributes: const)
  4041   (Lisp_Object attribute, Lisp_Object value)
  4042 {
  4043   if (EQ (value, Qunspecified) || (EQ (value, QCignore_defface)))
  4044     return Qt;
  4045   else if (EQ (attribute, QCheight))
  4046     return FIXNUMP (value) ? Qnil : Qt;
  4047   else
  4048     return Qnil;
  4049 }
  4050 
  4051 DEFUN ("merge-face-attribute", Fmerge_face_attribute, Smerge_face_attribute,
  4052        3, 3, 0,
  4053        doc: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
  4054 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
  4055 the result will be absolute, otherwise it will be relative.  */)
  4056   (Lisp_Object attribute, Lisp_Object value1, Lisp_Object value2)
  4057 {
  4058   if (EQ (value1, Qunspecified) || EQ (value1, QCignore_defface))
  4059     return value2;
  4060   else if (EQ (attribute, QCheight))
  4061     return merge_face_heights (value1, value2, value1);
  4062   else
  4063     return value1;
  4064 }
  4065 
  4066 
  4067 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute,
  4068        Sinternal_get_lisp_face_attribute,
  4069        2, 3, 0,
  4070        doc: /* Return face attribute KEYWORD of face SYMBOL.
  4071 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
  4072 face attribute name, signal an error.
  4073 If the optional argument FRAME is given, report on face SYMBOL in that
  4074 frame.  If FRAME is t, report on the defaults for face SYMBOL (for new
  4075 frames).  If FRAME is omitted or nil, use the selected frame.  */)
  4076   (Lisp_Object symbol, Lisp_Object keyword, Lisp_Object frame)
  4077 {
  4078   struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
  4079   Lisp_Object lface = lface_from_face_name (f, symbol, true), value = Qnil;
  4080 
  4081   CHECK_SYMBOL (symbol);
  4082   CHECK_SYMBOL (keyword);
  4083 
  4084   if (EQ (keyword, QCfamily))
  4085     value = LFACE_FAMILY (lface);
  4086   else if (EQ (keyword, QCfoundry))
  4087     value = LFACE_FOUNDRY (lface);
  4088   else if (EQ (keyword, QCheight))
  4089     value = LFACE_HEIGHT (lface);
  4090   else if (EQ (keyword, QCweight))
  4091     value = LFACE_WEIGHT (lface);
  4092   else if (EQ (keyword, QCslant))
  4093     value = LFACE_SLANT (lface);
  4094   else if (EQ (keyword, QCunderline))
  4095     value = LFACE_UNDERLINE (lface);
  4096   else if (EQ (keyword, QCoverline))
  4097     value = LFACE_OVERLINE (lface);
  4098   else if (EQ (keyword, QCstrike_through))
  4099     value = LFACE_STRIKE_THROUGH (lface);
  4100   else if (EQ (keyword, QCbox))
  4101     value = LFACE_BOX (lface);
  4102   else if (EQ (keyword, QCinverse_video)
  4103            || EQ (keyword, QCreverse_video))
  4104     value = LFACE_INVERSE (lface);
  4105   else if (EQ (keyword, QCforeground))
  4106     value = LFACE_FOREGROUND (lface);
  4107   else if (EQ (keyword, QCdistant_foreground))
  4108     value = LFACE_DISTANT_FOREGROUND (lface);
  4109   else if (EQ (keyword, QCbackground))
  4110     value = LFACE_BACKGROUND (lface);
  4111   else if (EQ (keyword, QCstipple))
  4112     value = LFACE_STIPPLE (lface);
  4113   else if (EQ (keyword, QCwidth))
  4114     value = LFACE_SWIDTH (lface);
  4115   else if (EQ (keyword, QCinherit))
  4116     value = LFACE_INHERIT (lface);
  4117   else if (EQ (keyword, QCextend))
  4118     value = LFACE_EXTEND (lface);
  4119   else if (EQ (keyword, QCfont))
  4120     value = LFACE_FONT (lface);
  4121   else if (EQ (keyword, QCfontset))
  4122     value = LFACE_FONTSET (lface);
  4123   else
  4124     signal_error ("Invalid face attribute name", keyword);
  4125 
  4126   if (IGNORE_DEFFACE_P (value))
  4127     return Qunspecified;
  4128 
  4129   return value;
  4130 }
  4131 
  4132 
  4133 DEFUN ("internal-lisp-face-attribute-values",
  4134        Finternal_lisp_face_attribute_values,
  4135        Sinternal_lisp_face_attribute_values, 1, 1, 0,
  4136        doc: /* Return a list of valid discrete values for face attribute ATTR.
  4137 Value is nil if ATTR doesn't have a discrete set of valid values.  */)
  4138   (Lisp_Object attr)
  4139 {
  4140   Lisp_Object result = Qnil;
  4141 
  4142   CHECK_SYMBOL (attr);
  4143 
  4144   if (EQ (attr, QCunderline) || EQ (attr, QCoverline)
  4145       || EQ (attr, QCstrike_through)
  4146       || EQ (attr, QCinverse_video)
  4147       || EQ (attr, QCreverse_video)
  4148       || EQ (attr, QCextend))
  4149     result = list2 (Qt, Qnil);
  4150 
  4151   return result;
  4152 }
  4153 
  4154 
  4155 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face,
  4156        Sinternal_merge_in_global_face, 2, 2, 0,
  4157        doc: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
  4158 Default face attributes override any local face attributes.  */)
  4159   (Lisp_Object face, Lisp_Object frame)
  4160 {
  4161   int i;
  4162   Lisp_Object global_lface, local_lface, *gvec, *lvec;
  4163   struct frame *f = XFRAME (frame);
  4164 
  4165   CHECK_LIVE_FRAME (frame);
  4166   global_lface = lface_from_face_name (NULL, face, true);
  4167   local_lface = lface_from_face_name (f, face, false);
  4168   if (NILP (local_lface))
  4169     local_lface = Finternal_make_lisp_face (face, frame);
  4170 
  4171   /* Make every specified global attribute override the local one.
  4172      BEWARE!! This is only used from `face-set-after-frame-default' where
  4173      the local frame is defined from default specs in `face-defface-spec'
  4174      and those should be overridden by global settings.  Hence the strange
  4175      "global before local" priority.  */
  4176   lvec = XVECTOR (local_lface)->contents;
  4177   gvec = XVECTOR (global_lface)->contents;
  4178   for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
  4179     if (IGNORE_DEFFACE_P (gvec[i]))
  4180       ASET (local_lface, i, Qunspecified);
  4181     else if (! UNSPECIFIEDP (gvec[i]))
  4182       ASET (local_lface, i, AREF (global_lface, i));
  4183 
  4184   /* If the default face was changed, update the face cache and the
  4185      `font' frame parameter.  */
  4186   if (EQ (face, Qdefault))
  4187     {
  4188       struct face_cache *c = FRAME_FACE_CACHE (f);
  4189       struct face *newface;
  4190       struct face *oldface =
  4191         c ? FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID) : NULL;
  4192       Lisp_Object attrs[LFACE_VECTOR_SIZE];
  4193 
  4194       /* This can be NULL (e.g., in batch mode).  */
  4195       if (oldface)
  4196         {
  4197           /* Ensure that the face vector is fully specified by merging
  4198              the previously-cached vector.  */
  4199           memcpy (attrs, oldface->lface, sizeof attrs);
  4200 
  4201           merge_face_vectors (NULL, f, lvec, attrs, 0);
  4202           vcopy (local_lface, 0, attrs, LFACE_VECTOR_SIZE);
  4203           newface = realize_face (c, lvec, DEFAULT_FACE_ID);
  4204 
  4205           if ((! UNSPECIFIEDP (gvec[LFACE_FAMILY_INDEX])
  4206                || ! UNSPECIFIEDP (gvec[LFACE_FOUNDRY_INDEX])
  4207                || ! UNSPECIFIEDP (gvec[LFACE_HEIGHT_INDEX])
  4208                || ! UNSPECIFIEDP (gvec[LFACE_WEIGHT_INDEX])
  4209                || ! UNSPECIFIEDP (gvec[LFACE_SLANT_INDEX])
  4210                || ! UNSPECIFIEDP (gvec[LFACE_SWIDTH_INDEX])
  4211                || ! UNSPECIFIEDP (gvec[LFACE_FONT_INDEX]))
  4212               && newface->font)
  4213             {
  4214               Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
  4215               AUTO_FRAME_ARG (arg, Qfont, name);
  4216 
  4217 #ifdef HAVE_WINDOW_SYSTEM
  4218               if (FRAME_WINDOW_P (f))
  4219                 /* This is a window-system frame.  Prevent changes of
  4220                    the `font' parameter here from messing with the
  4221                    `font-parameter' frame property, as the frame
  4222                    parameter is not being changed by the user.  */
  4223                 gui_set_frame_parameters_1 (f, arg, true);
  4224               else
  4225 #endif
  4226                 Fmodify_frame_parameters (frame, arg);
  4227             }
  4228 
  4229           if (STRINGP (gvec[LFACE_FOREGROUND_INDEX]))
  4230             {
  4231               AUTO_FRAME_ARG (arg, Qforeground_color,
  4232                               gvec[LFACE_FOREGROUND_INDEX]);
  4233               Fmodify_frame_parameters (frame, arg);
  4234             }
  4235 
  4236           if (STRINGP (gvec[LFACE_BACKGROUND_INDEX]))
  4237             {
  4238               AUTO_FRAME_ARG (arg, Qbackground_color,
  4239                               gvec[LFACE_BACKGROUND_INDEX]);
  4240               Fmodify_frame_parameters (frame, arg);
  4241             }
  4242         }
  4243     }
  4244 
  4245   return Qnil;
  4246 }
  4247 
  4248 
  4249 /* The following function is implemented for compatibility with 20.2.
  4250    The function is used in x-resolve-fonts when it is asked to
  4251    return fonts with the same size as the font of a face.  This is
  4252    done in fontset.el.  */
  4253 
  4254 DEFUN ("face-font", Fface_font, Sface_font, 1, 3, 0,
  4255        doc: /* Return the font name of face FACE, or nil if it is unspecified.
  4256 The font name is, by default, for ASCII characters.
  4257 If the optional argument FRAME is given, report on face FACE in that frame.
  4258 If FRAME is t, report on the defaults for face FACE (for new frames).
  4259   The font default for a face is either nil, or a list
  4260   of the form (bold), (italic) or (bold italic).
  4261 If FRAME is omitted or nil, use the selected frame.
  4262 If FRAME is anything but t, and the optional third argument CHARACTER
  4263 is given, return the font name used by FACE for CHARACTER on FRAME.  */)
  4264   (Lisp_Object face, Lisp_Object frame, Lisp_Object character)
  4265 {
  4266   if (EQ (frame, Qt))
  4267     {
  4268       Lisp_Object result = Qnil;
  4269       Lisp_Object lface = lface_from_face_name (NULL, face, true);
  4270 
  4271       if (!UNSPECIFIEDP (LFACE_WEIGHT (lface))
  4272           && !EQ (LFACE_WEIGHT (lface), Qnormal))
  4273         result = Fcons (Qbold, result);
  4274 
  4275       if (!UNSPECIFIEDP (LFACE_SLANT (lface))
  4276           && !EQ (LFACE_SLANT (lface), Qnormal))
  4277         result = Fcons (Qitalic, result);
  4278 
  4279       return result;
  4280     }
  4281   else
  4282     {
  4283       struct frame *f = decode_live_frame (frame);
  4284       int face_id = lookup_named_face (NULL, f, face, true);
  4285       struct face *fface = FACE_FROM_ID_OR_NULL (f, face_id);
  4286 
  4287       if (! fface)
  4288         return Qnil;
  4289 #ifdef HAVE_WINDOW_SYSTEM
  4290       if (FRAME_WINDOW_P (f) && !NILP (character))
  4291         {
  4292           CHECK_CHARACTER (character);
  4293           face_id = FACE_FOR_CHAR (f, fface, XFIXNUM (character), -1, Qnil);
  4294           fface = FACE_FROM_ID_OR_NULL (f, face_id);
  4295         }
  4296       return ((fface && fface->font)
  4297               ? fface->font->props[FONT_NAME_INDEX]
  4298               : Qnil);
  4299 #else  /* !HAVE_WINDOW_SYSTEM */
  4300       return build_string (FRAME_MSDOS_P (f)
  4301                            ? "ms-dos"
  4302                            : FRAME_W32_P (f) ? "w32term"
  4303                            :"tty");
  4304 #endif
  4305     }
  4306 }
  4307 
  4308 
  4309 /* Compare face-attribute values v1 and v2 for equality.  Value is true if
  4310    all attributes are `equal'.  Tries to be fast because this function
  4311    is called quite often.  */
  4312 
  4313 static bool
  4314 face_attr_equal_p (Lisp_Object v1, Lisp_Object v2)
  4315 {
  4316   /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
  4317      and the other is specified.  */
  4318   if (XTYPE (v1) != XTYPE (v2))
  4319     return false;
  4320 
  4321   if (EQ (v1, v2))
  4322     return true;
  4323 
  4324   switch (XTYPE (v1))
  4325     {
  4326     case Lisp_String:
  4327       if (SBYTES (v1) != SBYTES (v2))
  4328         return false;
  4329 
  4330       return memcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0;
  4331 
  4332     case_Lisp_Int:
  4333     case Lisp_Symbol:
  4334       return false;
  4335 
  4336     default:
  4337       return !NILP (Fequal (v1, v2));
  4338     }
  4339 }
  4340 
  4341 
  4342 /* Compare face vectors V1 and V2 for equality.  Value is true if
  4343    all attributes are `equal'.  Tries to be fast because this function
  4344    is called quite often.  */
  4345 
  4346 static bool
  4347 lface_equal_p (Lisp_Object *v1, Lisp_Object *v2)
  4348 {
  4349   int i;
  4350   bool equal_p = true;
  4351 
  4352   for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i)
  4353     equal_p = face_attr_equal_p (v1[i], v2[i]);
  4354 
  4355   return equal_p;
  4356 }
  4357 
  4358 
  4359 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p,
  4360        Sinternal_lisp_face_equal_p, 2, 3, 0,
  4361        doc: /* True if FACE1 and FACE2 are equal.
  4362 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
  4363 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
  4364 If FRAME is omitted or nil, use the selected frame.  */)
  4365   (Lisp_Object face1, Lisp_Object face2, Lisp_Object frame)
  4366 {
  4367   bool equal_p;
  4368   struct frame *f;
  4369   Lisp_Object lface1, lface2;
  4370 
  4371   /* Don't use decode_window_system_frame here because this function
  4372      is called before X frames exist.  At that time, if FRAME is nil,
  4373      selected_frame will be used which is the frame dumped with
  4374      Emacs.  That frame is not an X frame.  */
  4375   f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
  4376 
  4377   lface1 = lface_from_face_name (f, face1, true);
  4378   lface2 = lface_from_face_name (f, face2, true);
  4379   equal_p = lface_equal_p (XVECTOR (lface1)->contents,
  4380                            XVECTOR (lface2)->contents);
  4381   return equal_p ? Qt : Qnil;
  4382 }
  4383 
  4384 
  4385 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p,
  4386        Sinternal_lisp_face_empty_p, 1, 2, 0,
  4387        doc: /* True if FACE has no attribute specified.
  4388 If the optional argument FRAME is given, report on face FACE in that frame.
  4389 If FRAME is t, report on the defaults for face FACE (for new frames).
  4390 If FRAME is omitted or nil, use the selected frame.  */)
  4391   (Lisp_Object face, Lisp_Object frame)
  4392 {
  4393   struct frame *f = EQ (frame, Qt) ? NULL : decode_live_frame (frame);
  4394   Lisp_Object lface = lface_from_face_name (f, face, true);
  4395   int i;
  4396 
  4397   for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
  4398     if (!UNSPECIFIEDP (AREF (lface, i)))
  4399       break;
  4400 
  4401   return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
  4402 }
  4403 
  4404 DEFUN ("frame--face-hash-table", Fframe_face_hash_table, Sframe_face_hash_table,
  4405        0, 1, 0,
  4406        doc: /* Return a hash table of frame-local faces defined on FRAME.
  4407 For internal use only.  */)
  4408   (Lisp_Object frame)
  4409 {
  4410   return decode_live_frame (frame)->face_hash_table;
  4411 }
  4412 
  4413 
  4414 /* Return a hash code for Lisp string STRING with case ignored.  Used
  4415    below in computing a hash value for a Lisp face.  */
  4416 
  4417 static uintptr_t
  4418 hash_string_case_insensitive (Lisp_Object string)
  4419 {
  4420   const unsigned char *s;
  4421   uintptr_t hash = 0;
  4422   eassert (STRINGP (string));
  4423   for (s = SDATA (string); *s; ++s)
  4424     hash = (hash << 1) ^ c_tolower (*s);
  4425   return hash;
  4426 }
  4427 
  4428 
  4429 /* Return a hash code for face attribute vector V.  */
  4430 
  4431 static uintptr_t
  4432 lface_hash (Lisp_Object *v)
  4433 {
  4434   return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
  4435           ^ hash_string_case_insensitive (v[LFACE_FOUNDRY_INDEX])
  4436           ^ hash_string_case_insensitive (v[LFACE_FOREGROUND_INDEX])
  4437           ^ hash_string_case_insensitive (v[LFACE_BACKGROUND_INDEX])
  4438           ^ XHASH (v[LFACE_WEIGHT_INDEX])
  4439           ^ XHASH (v[LFACE_SLANT_INDEX])
  4440           ^ XHASH (v[LFACE_SWIDTH_INDEX])
  4441           ^ XHASH (v[LFACE_HEIGHT_INDEX]));
  4442 }
  4443 
  4444 #ifdef HAVE_WINDOW_SYSTEM
  4445 
  4446 /* Return true if LFACE1 and LFACE2 specify the same font (without
  4447    considering charsets/registries).  They do if they specify the same
  4448    family, point size, weight, width, slant, and font.  Both
  4449    LFACE1 and LFACE2 must be fully-specified.  */
  4450 
  4451 static bool
  4452 lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2)
  4453 {
  4454   eassert (lface_fully_specified_p (lface1)
  4455            && lface_fully_specified_p (lface2));
  4456   return (xstrcasecmp (SSDATA (lface1[LFACE_FAMILY_INDEX]),
  4457                        SSDATA (lface2[LFACE_FAMILY_INDEX])) == 0
  4458           && xstrcasecmp (SSDATA (lface1[LFACE_FOUNDRY_INDEX]),
  4459                           SSDATA (lface2[LFACE_FOUNDRY_INDEX])) == 0
  4460           && EQ (lface1[LFACE_HEIGHT_INDEX], lface2[LFACE_HEIGHT_INDEX])
  4461           && EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
  4462           && EQ (lface1[LFACE_WEIGHT_INDEX], lface2[LFACE_WEIGHT_INDEX])
  4463           && EQ (lface1[LFACE_SLANT_INDEX], lface2[LFACE_SLANT_INDEX])
  4464           && EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
  4465           && (EQ (lface1[LFACE_FONTSET_INDEX], lface2[LFACE_FONTSET_INDEX])
  4466               || (STRINGP (lface1[LFACE_FONTSET_INDEX])
  4467                   && STRINGP (lface2[LFACE_FONTSET_INDEX])
  4468                   && ! xstrcasecmp (SSDATA (lface1[LFACE_FONTSET_INDEX]),
  4469                                     SSDATA (lface2[LFACE_FONTSET_INDEX]))))
  4470           );
  4471 }
  4472 
  4473 #endif /* HAVE_WINDOW_SYSTEM */
  4474 
  4475 /***********************************************************************
  4476                             Realized Faces
  4477  ***********************************************************************/
  4478 
  4479 /* Allocate and return a new realized face for Lisp face attribute
  4480    vector ATTR.  */
  4481 
  4482 static struct face *
  4483 make_realized_face (Lisp_Object *attr)
  4484 {
  4485   enum { off = offsetof (struct face, id) };
  4486   struct face *face = xmalloc (sizeof *face);
  4487 
  4488   memcpy (face->lface, attr, sizeof face->lface);
  4489   memset (&face->id, 0, sizeof *face - off);
  4490   face->ascii_face = face;
  4491 
  4492   return face;
  4493 }
  4494 
  4495 
  4496 /* Free realized face FACE, including its X resources.  FACE may
  4497    be null.  */
  4498 
  4499 static void
  4500 free_realized_face (struct frame *f, struct face *face)
  4501 {
  4502   if (face)
  4503     {
  4504 #ifdef HAVE_WINDOW_SYSTEM
  4505       if (FRAME_WINDOW_P (f))
  4506         {
  4507           /* Free fontset of FACE if it is ASCII face.  */
  4508           if (face->fontset >= 0 && face == face->ascii_face)
  4509             free_face_fontset (f, face);
  4510           if (face->gc)
  4511             {
  4512               block_input ();
  4513               if (face->font)
  4514                 font_done_for_face (f, face);
  4515               x_free_gc (f, face->gc);
  4516               face->gc = 0;
  4517               unblock_input ();
  4518             }
  4519 #ifdef HAVE_X_WINDOWS
  4520           free_face_colors (f, face);
  4521 #endif /* HAVE_X_WINDOWS */
  4522           image_destroy_bitmap (f, face->stipple);
  4523         }
  4524 #endif /* HAVE_WINDOW_SYSTEM */
  4525 
  4526       xfree (face);
  4527     }
  4528 }
  4529 
  4530 #ifdef HAVE_WINDOW_SYSTEM
  4531 
  4532 /* Prepare face FACE for subsequent display on frame F.  This must be called
  4533    before using X resources of FACE to allocate GCs if they haven't been
  4534    allocated yet or have been freed by clearing the face cache.  */
  4535 
  4536 void
  4537 prepare_face_for_display (struct frame *f, struct face *face)
  4538 {
  4539   Emacs_GC egc;
  4540   unsigned long mask;
  4541 
  4542   eassert (FRAME_WINDOW_P (f));
  4543 
  4544   if (face->gc == 0)
  4545     {
  4546       mask = GCForeground | GCBackground | GCGraphicsExposures;
  4547 
  4548       egc.foreground = face->foreground;
  4549       egc.background = face->background;
  4550 #ifdef HAVE_X_WINDOWS
  4551       egc.graphics_exposures = False;
  4552 
  4553       /* While this was historically slower than a line_width of 0,
  4554          the difference no longer matters on modern X servers, so set
  4555          it to 1 in order for PolyLine requests to behave consistently
  4556          everywhere.  */
  4557       mask |= GCLineWidth;
  4558       egc.line_width = 1;
  4559 #endif
  4560 
  4561       block_input ();
  4562 #ifdef HAVE_X_WINDOWS
  4563       if (face->stipple)
  4564         {
  4565           egc.fill_style = FillOpaqueStippled;
  4566           egc.stipple = image_bitmap_pixmap (f, face->stipple);
  4567           mask |= GCFillStyle | GCStipple;
  4568         }
  4569 #endif
  4570       face->gc = x_create_gc (f, mask, &egc);
  4571       if (face->font)
  4572         font_prepare_for_face (f, face);
  4573       unblock_input ();
  4574     }
  4575 }
  4576 
  4577 #endif /* HAVE_WINDOW_SYSTEM */
  4578 
  4579 /* Returns the `distance' between the colors X and Y.  */
  4580 
  4581 static int
  4582 color_distance (Emacs_Color *x, Emacs_Color *y)
  4583 {
  4584   /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
  4585      Quoting from that paper:
  4586 
  4587          This formula has results that are very close to L*u*v* (with the
  4588          modified lightness curve) and, more importantly, it is a more even
  4589          algorithm: it does not have a range of colors where it suddenly
  4590          gives far from optimal results.
  4591 
  4592      See <https://www.compuphase.com/cmetric.htm> for more info.  */
  4593 
  4594   long long r = x->red   - y->red;
  4595   long long g = x->green - y->green;
  4596   long long b = x->blue  - y->blue;
  4597   long long r_mean = (x->red + y->red) >> 1;
  4598 
  4599   return (((((2 * 65536 + r_mean) * r * r) >> 16)
  4600            + 4 * g * g
  4601            + (((2 * 65536 + 65535 - r_mean) * b * b) >> 16))
  4602           >> 16);
  4603 }
  4604 
  4605 
  4606 DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 4, 0,
  4607        doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
  4608 COLOR1 and COLOR2 may be either strings containing the color name,
  4609 or lists of the form (RED GREEN BLUE), each in the range 0 to 65535 inclusive.
  4610 If FRAME is unspecified or nil, the current frame is used.
  4611 If METRIC is specified, it should be a function that accepts
  4612 two lists of the form (RED GREEN BLUE) aforementioned.
  4613 Despite the name, this is not a true distance metric as it does not satisfy
  4614 the triangle inequality.  */)
  4615   (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame,
  4616    Lisp_Object metric)
  4617 {
  4618   struct frame *f = decode_live_frame (frame);
  4619   Emacs_Color cdef1, cdef2;
  4620 
  4621   if (!(CONSP (color1) && parse_rgb_list (color1, &cdef1))
  4622       && !(STRINGP (color1)
  4623            && FRAME_TERMINAL (f)->defined_color_hook (f,
  4624                                                       SSDATA (color1),
  4625                                                       &cdef1,
  4626                                                       false,
  4627                                                       true)))
  4628     signal_error ("Invalid color", color1);
  4629   if (!(CONSP (color2) && parse_rgb_list (color2, &cdef2))
  4630       && !(STRINGP (color2)
  4631            && FRAME_TERMINAL (f)->defined_color_hook (f,
  4632                                                       SSDATA (color2),
  4633                                                       &cdef2,
  4634                                                       false,
  4635                                                       true)))
  4636     signal_error ("Invalid color", color2);
  4637 
  4638   if (NILP (metric))
  4639     return make_fixnum (color_distance (&cdef1, &cdef2));
  4640   else
  4641     return call2 (metric,
  4642                   list3i (cdef1.red, cdef1.green, cdef1.blue),
  4643                   list3i (cdef2.red, cdef2.green, cdef2.blue));
  4644 }
  4645 
  4646 
  4647 /***********************************************************************
  4648                               Face Cache
  4649  ***********************************************************************/
  4650 
  4651 /* Return a new face cache for frame F.  */
  4652 
  4653 static struct face_cache *
  4654 make_face_cache (struct frame *f)
  4655 {
  4656   struct face_cache *c = xmalloc (sizeof *c);
  4657 
  4658   c->buckets = xzalloc (FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets);
  4659   c->size = 50;
  4660   c->used = 0;
  4661   c->faces_by_id = xmalloc (c->size * sizeof *c->faces_by_id);
  4662   c->f = f;
  4663   c->menu_face_changed_p = menu_face_changed_default;
  4664   return c;
  4665 }
  4666 
  4667 #ifdef HAVE_WINDOW_SYSTEM
  4668 
  4669 /* Clear out all graphics contexts for all realized faces, except for
  4670    the basic faces.  This should be done from time to time just to avoid
  4671    keeping too many graphics contexts that are no longer needed.  */
  4672 
  4673 static void
  4674 clear_face_gcs (struct face_cache *c)
  4675 {
  4676   if (c && FRAME_WINDOW_P (c->f))
  4677     {
  4678       int i;
  4679       for (i = BASIC_FACE_ID_SENTINEL; i < c->used; ++i)
  4680         {
  4681           struct face *face = c->faces_by_id[i];
  4682           if (face && face->gc)
  4683             {
  4684               block_input ();
  4685               if (face->font)
  4686                 font_done_for_face (c->f, face);
  4687               x_free_gc (c->f, face->gc);
  4688               face->gc = 0;
  4689               unblock_input ();
  4690             }
  4691         }
  4692     }
  4693 }
  4694 
  4695 #endif /* HAVE_WINDOW_SYSTEM */
  4696 
  4697 /* Free all realized faces in face cache C, including basic faces.
  4698    C may be null.  If faces are freed, make sure the frame's current
  4699    matrix is marked invalid, so that a display caused by an expose
  4700    event doesn't try to use faces we destroyed.  */
  4701 
  4702 static void
  4703 free_realized_faces (struct face_cache *c)
  4704 {
  4705   if (c && c->used)
  4706     {
  4707       int i, size;
  4708       struct frame *f = c->f;
  4709 
  4710       /* We must block input here because we can't process X events
  4711          safely while only some faces are freed, or when the frame's
  4712          current matrix still references freed faces.  */
  4713       block_input ();
  4714 
  4715       for (i = 0; i < c->used; ++i)
  4716         {
  4717           free_realized_face (f, c->faces_by_id[i]);
  4718           c->faces_by_id[i] = NULL;
  4719         }
  4720 
  4721       /* Forget the escape-glyph and glyphless-char faces.  */
  4722       forget_escape_and_glyphless_faces ();
  4723       c->used = 0;
  4724       size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
  4725       memset (c->buckets, 0, size);
  4726 
  4727       /* Must do a thorough redisplay the next time.  Mark current
  4728          matrices as invalid because they will reference faces freed
  4729          above.  This function is also called when a frame is
  4730          destroyed.  In this case, the root window of F is nil.  */
  4731       if (WINDOWP (f->root_window))
  4732         {
  4733           clear_current_matrices (f);
  4734           fset_redisplay (f);
  4735         }
  4736 
  4737       unblock_input ();
  4738     }
  4739 }
  4740 
  4741 
  4742 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
  4743    This is done after attributes of a named face have been changed,
  4744    because we can't tell which realized faces depend on that face.  */
  4745 
  4746 void
  4747 free_all_realized_faces (Lisp_Object frame)
  4748 {
  4749   if (NILP (frame))
  4750     {
  4751       Lisp_Object rest;
  4752       FOR_EACH_FRAME (rest, frame)
  4753         free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
  4754       windows_or_buffers_changed = 58;
  4755     }
  4756   else
  4757     free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame)));
  4758 }
  4759 
  4760 
  4761 /* Free face cache C and faces in it, including their X resources.  */
  4762 
  4763 static void
  4764 free_face_cache (struct face_cache *c)
  4765 {
  4766   if (c)
  4767     {
  4768       free_realized_faces (c);
  4769       xfree (c->buckets);
  4770       xfree (c->faces_by_id);
  4771       xfree (c);
  4772     }
  4773 }
  4774 
  4775 
  4776 /* Cache realized face FACE in face cache C.  HASH is the hash value
  4777    of FACE.  If FACE is for ASCII characters (i.e. FACE->ascii_face ==
  4778    FACE), insert the new face to the beginning of the collision list
  4779    of the face hash table of C.  Otherwise, add the new face to the
  4780    end of the collision list.  This way, lookup_face can quickly find
  4781    that a requested face is not cached.  */
  4782 
  4783 static void
  4784 cache_face (struct face_cache *c, struct face *face, uintptr_t hash)
  4785 {
  4786   int i = hash % FACE_CACHE_BUCKETS_SIZE;
  4787 
  4788   face->hash = hash;
  4789 
  4790   if (face->ascii_face != face)
  4791     {
  4792       struct face *last = c->buckets[i];
  4793       if (last)
  4794         {
  4795           while (last->next)
  4796             last = last->next;
  4797           last->next = face;
  4798           face->prev = last;
  4799           face->next = NULL;
  4800         }
  4801       else
  4802         {
  4803           c->buckets[i] = face;
  4804           face->prev = face->next = NULL;
  4805         }
  4806     }
  4807   else
  4808     {
  4809       face->prev = NULL;
  4810       face->next = c->buckets[i];
  4811       if (face->next)
  4812         face->next->prev = face;
  4813       c->buckets[i] = face;
  4814     }
  4815 
  4816   /* Find a free slot in C->faces_by_id and use the index of the free
  4817      slot as FACE->id.  */
  4818   for (i = 0; i < c->used; ++i)
  4819     if (c->faces_by_id[i] == NULL)
  4820       break;
  4821   face->id = i;
  4822 
  4823 #ifdef GLYPH_DEBUG
  4824   /* Check that FACE got a unique id.  */
  4825   {
  4826     int j, n;
  4827     struct face *face1;
  4828 
  4829     for (j = n = 0; j < FACE_CACHE_BUCKETS_SIZE; ++j)
  4830       for (face1 = c->buckets[j]; face1; face1 = face1->next)
  4831         if (face1->id == i)
  4832           ++n;
  4833 
  4834     eassert (n == 1);
  4835   }
  4836 #endif /* GLYPH_DEBUG */
  4837 
  4838   /* Maybe enlarge C->faces_by_id.  */
  4839   if (i == c->used)
  4840     {
  4841       if (c->used == c->size)
  4842         c->faces_by_id = xpalloc (c->faces_by_id, &c->size, 1, MAX_FACE_ID,
  4843                                   sizeof *c->faces_by_id);
  4844       c->used++;
  4845     }
  4846 
  4847   c->faces_by_id[i] = face;
  4848 }
  4849 
  4850 
  4851 /* Remove face FACE from cache C.  */
  4852 
  4853 static void
  4854 uncache_face (struct face_cache *c, struct face *face)
  4855 {
  4856   int i = face->hash % FACE_CACHE_BUCKETS_SIZE;
  4857 
  4858   if (face->prev)
  4859     face->prev->next = face->next;
  4860   else
  4861     c->buckets[i] = face->next;
  4862 
  4863   if (face->next)
  4864     face->next->prev = face->prev;
  4865 
  4866   c->faces_by_id[face->id] = NULL;
  4867   if (face->id == c->used)
  4868     --c->used;
  4869 }
  4870 
  4871 
  4872 /* Look up a realized face with face attributes ATTR in the face cache
  4873    of frame F.  The face will be used to display ASCII characters.
  4874    Value is the ID of the face found.  If no suitable face is found,
  4875    realize a new one.  */
  4876 
  4877 static int
  4878 lookup_face (struct frame *f, Lisp_Object *attr)
  4879 {
  4880   struct face_cache *cache = FRAME_FACE_CACHE (f);
  4881   struct face *face;
  4882 
  4883   eassert (cache != NULL);
  4884   check_lface_attrs (attr);
  4885 
  4886   /* Look up ATTR in the face cache.  */
  4887   uintptr_t hash = lface_hash (attr);
  4888   int i = hash % FACE_CACHE_BUCKETS_SIZE;
  4889 
  4890   for (face = cache->buckets[i]; face; face = face->next)
  4891     {
  4892       if (face->ascii_face != face)
  4893         {
  4894           /* There's no more ASCII face.  */
  4895           face = NULL;
  4896           break;
  4897         }
  4898       if (face->hash == hash
  4899           && lface_equal_p (face->lface, attr))
  4900         break;
  4901     }
  4902 
  4903   /* If not found, realize a new face.  */
  4904   if (face == NULL)
  4905     face = realize_face (cache, attr, -1);
  4906 
  4907 #ifdef GLYPH_DEBUG
  4908   eassert (face == FACE_FROM_ID_OR_NULL (f, face->id));
  4909 #endif /* GLYPH_DEBUG */
  4910 
  4911   return face->id;
  4912 }
  4913 
  4914 #ifdef HAVE_WINDOW_SYSTEM
  4915 /* Look up a realized face that has the same attributes as BASE_FACE
  4916    except for the font in the face cache of frame F.  If FONT-OBJECT
  4917    is not nil, it is an already opened font.  If FONT-OBJECT is nil,
  4918    the face has no font.  Value is the ID of the face found.  If no
  4919    suitable face is found, realize a new one.  */
  4920 
  4921 int
  4922 face_for_font (struct frame *f, Lisp_Object font_object,
  4923                struct face *base_face)
  4924 {
  4925   struct face_cache *cache = FRAME_FACE_CACHE (f);
  4926   uintptr_t hash;
  4927   int i;
  4928   struct face *face;
  4929 
  4930   eassert (cache != NULL);
  4931   base_face = base_face->ascii_face;
  4932   hash = lface_hash (base_face->lface);
  4933   i = hash % FACE_CACHE_BUCKETS_SIZE;
  4934 
  4935   for (face = cache->buckets[i]; face; face = face->next)
  4936     {
  4937       if (face->ascii_face == face)
  4938         continue;
  4939       if (face->ascii_face == base_face
  4940           && face->font == (NILP (font_object) ? NULL
  4941                             : XFONT_OBJECT (font_object))
  4942           && lface_equal_p (face->lface, base_face->lface))
  4943         return face->id;
  4944     }
  4945 
  4946   /* If not found, realize a new face.  */
  4947   face = realize_non_ascii_face (f, font_object, base_face);
  4948   return face->id;
  4949 }
  4950 #endif  /* HAVE_WINDOW_SYSTEM */
  4951 
  4952 /* Return the face id of the realized face for named face SYMBOL on
  4953    frame F suitable for displaying ASCII characters.  Value is -1 if
  4954    the face couldn't be determined, which might happen if the default
  4955    face isn't realized and cannot be realized.  If window W is given,
  4956    consider face remappings specified for W or for W's buffer.  If W
  4957    is NULL, consider only frame-level face configuration.  */
  4958 int
  4959 lookup_named_face (struct window *w, struct frame *f,
  4960                    Lisp_Object symbol, bool signal_p)
  4961 {
  4962   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  4963   Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
  4964   struct face *default_face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
  4965 
  4966   if (default_face == NULL)
  4967     {
  4968       if (!realize_basic_faces (f))
  4969         return -1;
  4970       default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  4971     }
  4972 
  4973   if (! get_lface_attributes (w, f, symbol, symbol_attrs, signal_p, 0))
  4974     return -1;
  4975 
  4976   memcpy (attrs, default_face->lface, sizeof attrs);
  4977 
  4978   /* Make explicit any attributes whose value is 'reset'.  */
  4979   int i;
  4980   for (i = 1; i < LFACE_VECTOR_SIZE; i++)
  4981     if (EQ (symbol_attrs[i], Qreset))
  4982       symbol_attrs[i] = attrs[i];
  4983 
  4984   merge_face_vectors (w, f, symbol_attrs, attrs, 0);
  4985 
  4986   return lookup_face (f, attrs);
  4987 }
  4988 
  4989 
  4990 /* Return the display face-id of the basic face whose canonical face-id
  4991    is FACE_ID.  The return value will usually simply be FACE_ID, unless that
  4992    basic face has been remapped via Vface_remapping_alist.  This function is
  4993    conservative: if something goes wrong, it will simply return FACE_ID
  4994    rather than signal an error.  Window W, if non-NULL, is used to filter
  4995    face specifications for remapping.  */
  4996 int
  4997 lookup_basic_face (struct window *w, struct frame *f, int face_id)
  4998 {
  4999   Lisp_Object name, mapping;
  5000   int remapped_face_id;
  5001 
  5002   if (NILP (Vface_remapping_alist))
  5003     return face_id;             /* Nothing to do.  */
  5004 
  5005   switch (face_id)
  5006     {
  5007     case DEFAULT_FACE_ID:               name = Qdefault;                break;
  5008     case MODE_LINE_ACTIVE_FACE_ID:      name = Qmode_line_active;       break;
  5009     case MODE_LINE_INACTIVE_FACE_ID:    name = Qmode_line_inactive;     break;
  5010     case HEADER_LINE_FACE_ID:           name = Qheader_line;            break;
  5011     case TAB_LINE_FACE_ID:              name = Qtab_line;               break;
  5012     case TAB_BAR_FACE_ID:               name = Qtab_bar;                break;
  5013     case TOOL_BAR_FACE_ID:              name = Qtool_bar;               break;
  5014     case FRINGE_FACE_ID:                name = Qfringe;                 break;
  5015     case SCROLL_BAR_FACE_ID:            name = Qscroll_bar;             break;
  5016     case BORDER_FACE_ID:                name = Qborder;                 break;
  5017     case CURSOR_FACE_ID:                name = Qcursor;                 break;
  5018     case MOUSE_FACE_ID:                 name = Qmouse;                  break;
  5019     case MENU_FACE_ID:                  name = Qmenu;                   break;
  5020     case WINDOW_DIVIDER_FACE_ID:        name = Qwindow_divider;         break;
  5021     case VERTICAL_BORDER_FACE_ID:       name = Qvertical_border;        break;
  5022     case WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID:    name = Qwindow_divider_first_pixel;     break;
  5023     case WINDOW_DIVIDER_LAST_PIXEL_FACE_ID:     name = Qwindow_divider_last_pixel;      break;
  5024     case INTERNAL_BORDER_FACE_ID:       name = Qinternal_border;        break;
  5025     case CHILD_FRAME_BORDER_FACE_ID:    name = Qchild_frame_border;     break;
  5026 
  5027     default:
  5028       emacs_abort (); /* the caller is supposed to pass us a basic face id */
  5029     }
  5030 
  5031   /* Do a quick scan through Vface_remapping_alist, and return immediately
  5032      if there is no remapping for face NAME.  This is just an optimization
  5033      for the very common no-remapping case.  */
  5034   mapping = assq_no_quit (name, Vface_remapping_alist);
  5035   if (NILP (mapping))
  5036     return face_id;             /* Give up.  */
  5037 
  5038   /* If there is a remapping entry, lookup the face using NAME, which will
  5039      handle the remapping too.  */
  5040   remapped_face_id = lookup_named_face (w, f, name, false);
  5041   if (remapped_face_id < 0)
  5042     return face_id;             /* Give up. */
  5043 
  5044   return remapped_face_id;
  5045 }
  5046 
  5047 
  5048 /* Return a face for charset ASCII that is like the face with id
  5049    FACE_ID on frame F, but has a font that is STEPS steps smaller.
  5050    STEPS < 0 means larger.  Value is the id of the face.  */
  5051 
  5052 int
  5053 smaller_face (struct frame *f, int face_id, int steps)
  5054 {
  5055 #ifdef HAVE_WINDOW_SYSTEM
  5056   struct face *face;
  5057   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  5058   int pt, last_pt, last_height;
  5059   int delta;
  5060   int new_face_id;
  5061   struct face *new_face;
  5062 
  5063   /* If not called for an X frame, just return the original face.  */
  5064   if (FRAME_TERMCAP_P (f))
  5065     return face_id;
  5066 
  5067   /* Try in increments of 1/2 pt.  */
  5068   delta = steps < 0 ? 5 : -5;
  5069   steps = eabs (steps);
  5070 
  5071   face = FACE_FROM_ID (f, face_id);
  5072   memcpy (attrs, face->lface, sizeof attrs);
  5073   pt = last_pt = XFIXNAT (attrs[LFACE_HEIGHT_INDEX]);
  5074   new_face_id = face_id;
  5075   last_height = FONT_HEIGHT (face->font);
  5076 
  5077   while (steps
  5078          && pt + delta > 0
  5079          /* Give up if we cannot find a font within 10pt.  */
  5080          && eabs (last_pt - pt) < 100)
  5081     {
  5082       /* Look up a face for a slightly smaller/larger font.  */
  5083       pt += delta;
  5084       attrs[LFACE_HEIGHT_INDEX] = make_fixnum (pt);
  5085       new_face_id = lookup_face (f, attrs);
  5086       new_face = FACE_FROM_ID (f, new_face_id);
  5087 
  5088       /* If height changes, count that as one step.  */
  5089       if ((delta < 0 && FONT_HEIGHT (new_face->font) < last_height)
  5090           || (delta > 0 && FONT_HEIGHT (new_face->font) > last_height))
  5091         {
  5092           --steps;
  5093           last_height = FONT_HEIGHT (new_face->font);
  5094           last_pt = pt;
  5095         }
  5096     }
  5097 
  5098   return new_face_id;
  5099 
  5100 #else /* not HAVE_WINDOW_SYSTEM */
  5101 
  5102   return face_id;
  5103 
  5104 #endif /* not HAVE_WINDOW_SYSTEM */
  5105 }
  5106 
  5107 
  5108 /* Return a face for charset ASCII that is like the face with id
  5109    FACE_ID on frame F, but has height HEIGHT.  */
  5110 
  5111 int
  5112 face_with_height (struct frame *f, int face_id, int height)
  5113 {
  5114 #ifdef HAVE_WINDOW_SYSTEM
  5115   struct face *face;
  5116   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  5117 
  5118   if (FRAME_TERMCAP_P (f)
  5119       || height <= 0)
  5120     return face_id;
  5121 
  5122   face = FACE_FROM_ID (f, face_id);
  5123   memcpy (attrs, face->lface, sizeof attrs);
  5124   attrs[LFACE_HEIGHT_INDEX] = make_fixnum (height);
  5125   font_clear_prop (attrs, FONT_SIZE_INDEX);
  5126   face_id = lookup_face (f, attrs);
  5127 #endif /* HAVE_WINDOW_SYSTEM */
  5128 
  5129   return face_id;
  5130 }
  5131 
  5132 
  5133 /* Return the face id of the realized face for named face SYMBOL on
  5134    frame F suitable for displaying ASCII characters, and use
  5135    attributes of the face FACE_ID for attributes that aren't
  5136    completely specified by SYMBOL.  This is like lookup_named_face,
  5137    except that the default attributes come from FACE_ID, not from the
  5138    default face.  FACE_ID is assumed to be already realized.
  5139    Window W, if non-NULL, filters face specifications.  */
  5140 int
  5141 lookup_derived_face (struct window *w,
  5142                      struct frame *f, Lisp_Object symbol, int face_id,
  5143                      bool signal_p)
  5144 {
  5145   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  5146   Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
  5147   struct face *default_face;
  5148 
  5149   if (!get_lface_attributes (w, f, symbol, symbol_attrs, signal_p, 0))
  5150     return -1;
  5151 
  5152   default_face = FACE_FROM_ID (f, face_id);
  5153   memcpy (attrs, default_face->lface, sizeof attrs);
  5154 
  5155   /* Make explicit any attributes whose value is 'reset'.  */
  5156   int i;
  5157   for (i = 1; i < LFACE_VECTOR_SIZE; i++)
  5158     if (EQ (symbol_attrs[i], Qreset))
  5159       symbol_attrs[i] = attrs[i];
  5160 
  5161   merge_face_vectors (w, f, symbol_attrs, attrs, 0);
  5162   return lookup_face (f, attrs);
  5163 }
  5164 
  5165 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
  5166        Sface_attributes_as_vector, 1, 1, 0,
  5167        doc: /* Return a vector of face attributes corresponding to PLIST.  */)
  5168   (Lisp_Object plist)
  5169 {
  5170   Lisp_Object lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
  5171   merge_face_ref (NULL, XFRAME (selected_frame),
  5172                   plist, XVECTOR (lface)->contents,
  5173                   true, NULL, 0);
  5174   return lface;
  5175 }
  5176 
  5177 
  5178 
  5179 /***********************************************************************
  5180                         Face capability testing
  5181  ***********************************************************************/
  5182 
  5183 
  5184 /* If the distance (as returned by color_distance) between two colors is
  5185    less than this, then they are considered the same, for determining
  5186    whether a color is supported or not.  */
  5187 
  5188 #define TTY_SAME_COLOR_THRESHOLD  10000
  5189 
  5190 #ifdef HAVE_WINDOW_SYSTEM
  5191 
  5192 /* Return true if all the face attributes in ATTRS are supported
  5193    on the window-system frame F.
  5194 
  5195    The definition of `supported' is somewhat heuristic, but basically means
  5196    that a face containing all the attributes in ATTRS, when merged with the
  5197    default face for display, can be represented in a way that's
  5198 
  5199     (1) different in appearance from the default face, and
  5200     (2) `close in spirit' to what the attributes specify, if not exact.  */
  5201 
  5202 static bool
  5203 gui_supports_face_attributes_p (struct frame *f,
  5204                                 Lisp_Object attrs[LFACE_VECTOR_SIZE],
  5205                                 struct face *def_face)
  5206 {
  5207   Lisp_Object *def_attrs = def_face->lface;
  5208   Lisp_Object lattrs[LFACE_VECTOR_SIZE];
  5209 
  5210   /* Make explicit any attributes whose value is 'reset'.  */
  5211   int i;
  5212   for (i = 1; i < LFACE_VECTOR_SIZE; i++)
  5213     {
  5214       if (EQ (attrs[i], Qreset))
  5215         lattrs[i] = def_attrs[i];
  5216       else
  5217         lattrs[i] = attrs[i];
  5218     }
  5219 
  5220   /* Check that other specified attributes are different from the
  5221      default face.  */
  5222   if ((!UNSPECIFIEDP (lattrs[LFACE_UNDERLINE_INDEX])
  5223        && face_attr_equal_p (lattrs[LFACE_UNDERLINE_INDEX],
  5224                              def_attrs[LFACE_UNDERLINE_INDEX]))
  5225       || (!UNSPECIFIEDP (lattrs[LFACE_INVERSE_INDEX])
  5226           && face_attr_equal_p (lattrs[LFACE_INVERSE_INDEX],
  5227                                 def_attrs[LFACE_INVERSE_INDEX]))
  5228       || (!UNSPECIFIEDP (lattrs[LFACE_EXTEND_INDEX])
  5229           && face_attr_equal_p (lattrs[LFACE_EXTEND_INDEX],
  5230                                 def_attrs[LFACE_EXTEND_INDEX]))
  5231       || (!UNSPECIFIEDP (lattrs[LFACE_FOREGROUND_INDEX])
  5232           && face_attr_equal_p (lattrs[LFACE_FOREGROUND_INDEX],
  5233                                 def_attrs[LFACE_FOREGROUND_INDEX]))
  5234       || (!UNSPECIFIEDP (lattrs[LFACE_DISTANT_FOREGROUND_INDEX])
  5235           && face_attr_equal_p (lattrs[LFACE_DISTANT_FOREGROUND_INDEX],
  5236                                 def_attrs[LFACE_DISTANT_FOREGROUND_INDEX]))
  5237       || (!UNSPECIFIEDP (lattrs[LFACE_BACKGROUND_INDEX])
  5238           && face_attr_equal_p (lattrs[LFACE_BACKGROUND_INDEX],
  5239                                 def_attrs[LFACE_BACKGROUND_INDEX]))
  5240       || (!UNSPECIFIEDP (lattrs[LFACE_STIPPLE_INDEX])
  5241           && face_attr_equal_p (lattrs[LFACE_STIPPLE_INDEX],
  5242                                 def_attrs[LFACE_STIPPLE_INDEX]))
  5243       || (!UNSPECIFIEDP (lattrs[LFACE_OVERLINE_INDEX])
  5244           && face_attr_equal_p (lattrs[LFACE_OVERLINE_INDEX],
  5245                                 def_attrs[LFACE_OVERLINE_INDEX]))
  5246       || (!UNSPECIFIEDP (lattrs[LFACE_STRIKE_THROUGH_INDEX])
  5247           && face_attr_equal_p (lattrs[LFACE_STRIKE_THROUGH_INDEX],
  5248                                 def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
  5249       || (!UNSPECIFIEDP (lattrs[LFACE_BOX_INDEX])
  5250           && face_attr_equal_p (lattrs[LFACE_BOX_INDEX],
  5251                                 def_attrs[LFACE_BOX_INDEX])))
  5252     return false;
  5253 
  5254   /* Check font-related attributes, as those are the most commonly
  5255      "unsupported" on a window-system (because of missing fonts).  */
  5256   if (!UNSPECIFIEDP (lattrs[LFACE_FAMILY_INDEX])
  5257       || !UNSPECIFIEDP (lattrs[LFACE_FOUNDRY_INDEX])
  5258       || !UNSPECIFIEDP (lattrs[LFACE_HEIGHT_INDEX])
  5259       || !UNSPECIFIEDP (lattrs[LFACE_WEIGHT_INDEX])
  5260       || !UNSPECIFIEDP (lattrs[LFACE_SLANT_INDEX])
  5261       || !UNSPECIFIEDP (lattrs[LFACE_SWIDTH_INDEX]))
  5262     {
  5263       int face_id;
  5264       struct face *face;
  5265       Lisp_Object merged_attrs[LFACE_VECTOR_SIZE];
  5266       int i;
  5267 
  5268       memcpy (merged_attrs, def_attrs, sizeof merged_attrs);
  5269 
  5270       merge_face_vectors (NULL, f, attrs, merged_attrs, 0);
  5271 
  5272       face_id = lookup_face (f, merged_attrs);
  5273       face = FACE_FROM_ID_OR_NULL (f, face_id);
  5274 
  5275       if (! face)
  5276         error ("Cannot make face");
  5277 
  5278       /* If the font is the same, or no font is found, then not
  5279          supported.  */
  5280       if (face->font == def_face->font
  5281           || ! face->font)
  5282         return false;
  5283       for (i = FONT_TYPE_INDEX; i <= FONT_SIZE_INDEX; i++)
  5284         if (! EQ (face->font->props[i], def_face->font->props[i]))
  5285           {
  5286             Lisp_Object s1, s2;
  5287 
  5288             if (i < FONT_FOUNDRY_INDEX || i > FONT_REGISTRY_INDEX
  5289                 || face->font->driver->case_sensitive)
  5290               return true;
  5291             s1 = SYMBOL_NAME (face->font->props[i]);
  5292             s2 = SYMBOL_NAME (def_face->font->props[i]);
  5293             if (! BASE_EQ (Fcompare_strings (s1, make_fixnum (0), Qnil,
  5294                                              s2, make_fixnum (0), Qnil, Qt),
  5295                            Qt))
  5296               return true;
  5297           }
  5298       return false;
  5299     }
  5300 
  5301   /* Everything checks out, this face is supported.  */
  5302   return true;
  5303 }
  5304 
  5305 #endif  /* HAVE_WINDOW_SYSTEM */
  5306 
  5307 /* Return true if all the face attributes in ATTRS are supported
  5308    on the tty frame F.
  5309 
  5310    The definition of `supported' is somewhat heuristic, but basically means
  5311    that a face containing all the attributes in ATTRS, when merged
  5312    with the default face for display, can be represented in a way that's
  5313 
  5314     (1) different in appearance from the default face, and
  5315     (2) `close in spirit' to what the attributes specify, if not exact.
  5316 
  5317    Point (2) implies that a `:weight black' attribute will be satisfied
  5318    by any terminal that can display bold, and a `:foreground "yellow"' as
  5319    long as the terminal can display a yellowish color, but `:slant italic'
  5320    will _not_ be satisfied by the tty display code's automatic
  5321    substitution of a `dim' face for italic.  */
  5322 
  5323 static bool
  5324 tty_supports_face_attributes_p (struct frame *f,
  5325                                 Lisp_Object attrs[LFACE_VECTOR_SIZE],
  5326                                 struct face *def_face)
  5327 {
  5328   int weight, slant;
  5329   Lisp_Object val, fg, bg;
  5330   Emacs_Color fg_tty_color, fg_std_color;
  5331   Emacs_Color bg_tty_color, bg_std_color;
  5332   unsigned test_caps = 0;
  5333   Lisp_Object *def_attrs = def_face->lface;
  5334 
  5335   /* First check some easy-to-check stuff; ttys support none of the
  5336      following attributes, so we can just return false if any are requested
  5337      (even if `nominal' values are specified, we should still return false,
  5338      as that will be the same value that the default face uses).  We
  5339      consider :slant unsupportable on ttys, even though the face code
  5340      actually `fakes' them using a dim attribute if possible.  This is
  5341      because the faked result is too different from what the face
  5342      specifies.  */
  5343   if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
  5344       || !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
  5345       || !UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
  5346       || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
  5347       || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
  5348       || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
  5349       || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]))
  5350     return false;
  5351 
  5352   /* Test for terminal `capabilities' (non-color character attributes).  */
  5353 
  5354   /* font weight (bold/dim) */
  5355   val = attrs[LFACE_WEIGHT_INDEX];
  5356   if (!UNSPECIFIEDP (val)
  5357       && (weight = FONT_WEIGHT_NAME_NUMERIC (val), weight >= 0))
  5358     {
  5359       int def_weight = FONT_WEIGHT_NAME_NUMERIC (def_attrs[LFACE_WEIGHT_INDEX]);
  5360 
  5361       if (weight > 100)
  5362         {
  5363           if (def_weight > 100)
  5364             return false;       /* same as default */
  5365           test_caps = TTY_CAP_BOLD;
  5366         }
  5367       else if (weight < 100)
  5368         {
  5369           if (def_weight < 100)
  5370             return false;       /* same as default */
  5371           test_caps = TTY_CAP_DIM;
  5372         }
  5373       else if (def_weight == 100)
  5374         return false;           /* same as default */
  5375     }
  5376 
  5377   /* font slant */
  5378   val = attrs[LFACE_SLANT_INDEX];
  5379   if (!UNSPECIFIEDP (val)
  5380       && (slant = FONT_SLANT_NAME_NUMERIC (val), slant >= 0))
  5381     {
  5382       int def_slant = FONT_SLANT_NAME_NUMERIC (def_attrs[LFACE_SLANT_INDEX]);
  5383       if (slant == 100 || slant == def_slant)
  5384         return false;           /* same as default */
  5385       else
  5386         test_caps |= TTY_CAP_ITALIC;
  5387     }
  5388 
  5389   /* underlining */
  5390   val = attrs[LFACE_UNDERLINE_INDEX];
  5391   if (!UNSPECIFIEDP (val))
  5392     {
  5393       if (STRINGP (val))
  5394         return false;           /* ttys can't use colored underlines */
  5395       else if (EQ (CAR_SAFE (val), QCstyle) && EQ (CAR_SAFE (CDR_SAFE (val)), Qwave))
  5396         return false;           /* ttys can't use wave underlines */
  5397       else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX]))
  5398         return false;           /* same as default */
  5399       else
  5400         test_caps |= TTY_CAP_UNDERLINE;
  5401     }
  5402 
  5403   /* inverse video */
  5404   val = attrs[LFACE_INVERSE_INDEX];
  5405   if (!UNSPECIFIEDP (val))
  5406     {
  5407       if (face_attr_equal_p (val, def_attrs[LFACE_INVERSE_INDEX]))
  5408         return false;           /* same as default */
  5409       else
  5410         test_caps |= TTY_CAP_INVERSE;
  5411     }
  5412 
  5413   /* strike through */
  5414   val = attrs[LFACE_STRIKE_THROUGH_INDEX];
  5415   if (!UNSPECIFIEDP (val))
  5416     {
  5417       if (face_attr_equal_p (val, def_attrs[LFACE_STRIKE_THROUGH_INDEX]))
  5418         return false;           /* same as default */
  5419       else
  5420         test_caps |= TTY_CAP_STRIKE_THROUGH;
  5421     }
  5422 
  5423   /* Color testing.  */
  5424 
  5425   /* Check if foreground color is close enough.  */
  5426   fg = attrs[LFACE_FOREGROUND_INDEX];
  5427   if (STRINGP (fg))
  5428     {
  5429       Lisp_Object def_fg = def_attrs[LFACE_FOREGROUND_INDEX];
  5430 
  5431       if (face_attr_equal_p (fg, def_fg))
  5432         return false;           /* same as default */
  5433       else if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
  5434         return false;           /* not a valid color */
  5435       else if (color_distance (&fg_tty_color, &fg_std_color)
  5436                > TTY_SAME_COLOR_THRESHOLD)
  5437         return false;           /* displayed color is too different */
  5438       else
  5439         /* Make sure the color is really different from the default.  */
  5440         {
  5441           Emacs_Color def_fg_color;
  5442           if (tty_lookup_color (f, def_fg, &def_fg_color, 0)
  5443               && (color_distance (&fg_tty_color, &def_fg_color)
  5444                   <= TTY_SAME_COLOR_THRESHOLD))
  5445             return false;
  5446         }
  5447     }
  5448 
  5449   /* Check if background color is close enough.  */
  5450   bg = attrs[LFACE_BACKGROUND_INDEX];
  5451   if (STRINGP (bg))
  5452     {
  5453       Lisp_Object def_bg = def_attrs[LFACE_BACKGROUND_INDEX];
  5454 
  5455       if (face_attr_equal_p (bg, def_bg))
  5456         return false;           /* same as default */
  5457       else if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
  5458         return false;           /* not a valid color */
  5459       else if (color_distance (&bg_tty_color, &bg_std_color)
  5460                > TTY_SAME_COLOR_THRESHOLD)
  5461         return false;           /* displayed color is too different */
  5462       else
  5463         /* Make sure the color is really different from the default.  */
  5464         {
  5465           Emacs_Color def_bg_color;
  5466           if (tty_lookup_color (f, def_bg, &def_bg_color, 0)
  5467               && (color_distance (&bg_tty_color, &def_bg_color)
  5468                   <= TTY_SAME_COLOR_THRESHOLD))
  5469             return false;
  5470         }
  5471     }
  5472 
  5473   /* If both foreground and background are requested, see if the
  5474      distance between them is OK.  We just check to see if the distance
  5475      between the tty's foreground and background is close enough to the
  5476      distance between the standard foreground and background.  */
  5477   if (STRINGP (fg) && STRINGP (bg))
  5478     {
  5479       int delta_delta
  5480         = (color_distance (&fg_std_color, &bg_std_color)
  5481            - color_distance (&fg_tty_color, &bg_tty_color));
  5482       if (delta_delta > TTY_SAME_COLOR_THRESHOLD
  5483           || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
  5484         return false;
  5485     }
  5486 
  5487 
  5488   /* See if the capabilities we selected above are supported, with the
  5489      given colors.  */
  5490   return tty_capable_p (FRAME_TTY (f), test_caps);
  5491 }
  5492 
  5493 
  5494 DEFUN ("display-supports-face-attributes-p",
  5495        Fdisplay_supports_face_attributes_p, Sdisplay_supports_face_attributes_p,
  5496        1, 2, 0,
  5497        doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
  5498 The optional argument DISPLAY can be a display name, a frame, or
  5499 nil (meaning the selected frame's display).
  5500 
  5501 For instance, to check whether the display supports underlining:
  5502 
  5503   (display-supports-face-attributes-p \\='(:underline t))
  5504 
  5505 The definition of `supported' is somewhat heuristic, but basically means
  5506 that a face containing all the attributes in ATTRIBUTES, when merged
  5507 with the default face for display, can be represented in a way that's
  5508 
  5509  (1) different in appearance from the default face, and
  5510  (2) `close in spirit' to what the attributes specify, if not exact.
  5511 
  5512 Point (2) implies that a `:weight black' attribute will be satisfied by
  5513 any display that can display bold, and a `:foreground \"yellow\"' as long
  5514 as it can display a yellowish color, but `:slant italic' will _not_ be
  5515 satisfied by the tty display code's automatic substitution of a `dim'
  5516 face for italic.  */)
  5517   (Lisp_Object attributes, Lisp_Object display)
  5518 {
  5519   bool supports = false;
  5520   int i;
  5521   Lisp_Object frame;
  5522   struct frame *f;
  5523   struct face *def_face;
  5524   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  5525 
  5526   if (noninteractive || !initialized)
  5527     /* We may not be able to access low-level face information in batch
  5528        mode, or before being dumped, and this function is not going to
  5529        be very useful in those cases anyway, so just give up.  */
  5530     return Qnil;
  5531 
  5532   if (NILP (display))
  5533     frame = selected_frame;
  5534   else if (FRAMEP (display))
  5535     frame = display;
  5536   else
  5537     {
  5538       /* Find any frame on DISPLAY.  */
  5539       Lisp_Object tail;
  5540 
  5541       frame = Qnil;
  5542       FOR_EACH_FRAME (tail, frame)
  5543         if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
  5544                                         XFRAME (frame)->param_alist)),
  5545                            display)))
  5546           break;
  5547     }
  5548 
  5549   CHECK_LIVE_FRAME (frame);
  5550   f = XFRAME (frame);
  5551 
  5552   for (i = 0; i < LFACE_VECTOR_SIZE; i++)
  5553     attrs[i] = Qunspecified;
  5554   merge_face_ref (NULL, f, attributes, attrs, true, NULL, 0);
  5555 
  5556   def_face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
  5557   if (def_face == NULL)
  5558     {
  5559       if (! realize_basic_faces (f))
  5560         error ("Cannot realize default face");
  5561       def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  5562     }
  5563 
  5564   /* Dispatch to the appropriate handler.  */
  5565   if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
  5566     supports = tty_supports_face_attributes_p (f, attrs, def_face);
  5567 #ifdef HAVE_WINDOW_SYSTEM
  5568   else
  5569     supports = gui_supports_face_attributes_p (f, attrs, def_face);
  5570 #endif
  5571 
  5572   return supports ? Qt : Qnil;
  5573 }
  5574 
  5575 
  5576 /***********************************************************************
  5577                             Font selection
  5578  ***********************************************************************/
  5579 
  5580 DEFUN ("internal-set-font-selection-order",
  5581        Finternal_set_font_selection_order,
  5582        Sinternal_set_font_selection_order, 1, 1, 0,
  5583        doc: /* Set font selection order for face font selection to ORDER.
  5584 ORDER must be a list of length 4 containing the symbols `:width',
  5585 `:height', `:weight', and `:slant'.  Face attributes appearing
  5586 first in ORDER are matched first, e.g. if `:height' appears before
  5587 `:weight' in ORDER, font selection first tries to find a font with
  5588 a suitable height, and then tries to match the font weight.
  5589 Value is ORDER.  */)
  5590   (Lisp_Object order)
  5591 {
  5592   Lisp_Object list;
  5593   int i;
  5594   int indices[ARRAYELTS (font_sort_order)];
  5595 
  5596   CHECK_LIST (order);
  5597   memset (indices, 0, sizeof indices);
  5598   i = 0;
  5599 
  5600   for (list = order;
  5601        CONSP (list) && i < ARRAYELTS (indices);
  5602        list = XCDR (list), ++i)
  5603     {
  5604       Lisp_Object attr = XCAR (list);
  5605       int xlfd;
  5606 
  5607       if (EQ (attr, QCwidth))
  5608         xlfd = XLFD_SWIDTH;
  5609       else if (EQ (attr, QCheight))
  5610         xlfd = XLFD_POINT_SIZE;
  5611       else if (EQ (attr, QCweight))
  5612         xlfd = XLFD_WEIGHT;
  5613       else if (EQ (attr, QCslant))
  5614         xlfd = XLFD_SLANT;
  5615       else
  5616         break;
  5617 
  5618       if (indices[i] != 0)
  5619         break;
  5620       indices[i] = xlfd;
  5621     }
  5622 
  5623   if (!NILP (list) || i != ARRAYELTS (indices))
  5624     signal_error ("Invalid font sort order", order);
  5625   for (i = 0; i < ARRAYELTS (font_sort_order); ++i)
  5626     if (indices[i] == 0)
  5627       signal_error ("Invalid font sort order", order);
  5628 
  5629   if (memcmp (indices, font_sort_order, sizeof indices) != 0)
  5630     {
  5631       memcpy (font_sort_order, indices, sizeof font_sort_order);
  5632       free_all_realized_faces (Qnil);
  5633     }
  5634 
  5635   font_update_sort_order (font_sort_order);
  5636 
  5637   return Qnil;
  5638 }
  5639 
  5640 
  5641 DEFUN ("internal-set-alternative-font-family-alist",
  5642        Finternal_set_alternative_font_family_alist,
  5643        Sinternal_set_alternative_font_family_alist, 1, 1, 0,
  5644        doc: /* Define alternative font families to try in face font selection.
  5645 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
  5646 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
  5647 be found.  Value is ALIST.  */)
  5648   (Lisp_Object alist)
  5649 {
  5650   Lisp_Object entry, tail, tail2;
  5651 
  5652   CHECK_LIST (alist);
  5653   alist = Fcopy_sequence (alist);
  5654   for (tail = alist; CONSP (tail); tail = XCDR (tail))
  5655     {
  5656       entry = XCAR (tail);
  5657       CHECK_LIST (entry);
  5658       entry = Fcopy_sequence (entry);
  5659       XSETCAR (tail, entry);
  5660       for (tail2 = entry; CONSP (tail2); tail2 = XCDR (tail2))
  5661         XSETCAR (tail2, Fintern (XCAR (tail2), Qnil));
  5662     }
  5663 
  5664   Vface_alternative_font_family_alist = alist;
  5665   free_all_realized_faces (Qnil);
  5666   return alist;
  5667 }
  5668 
  5669 
  5670 DEFUN ("internal-set-alternative-font-registry-alist",
  5671        Finternal_set_alternative_font_registry_alist,
  5672        Sinternal_set_alternative_font_registry_alist, 1, 1, 0,
  5673        doc: /* Define alternative font registries to try in face font selection.
  5674 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
  5675 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
  5676 be found.  Value is ALIST.  */)
  5677   (Lisp_Object alist)
  5678 {
  5679   Lisp_Object entry, tail, tail2;
  5680 
  5681   CHECK_LIST (alist);
  5682   alist = Fcopy_sequence (alist);
  5683   for (tail = alist; CONSP (tail); tail = XCDR (tail))
  5684     {
  5685       entry = XCAR (tail);
  5686       CHECK_LIST (entry);
  5687       entry = Fcopy_sequence (entry);
  5688       XSETCAR (tail, entry);
  5689       for (tail2 = entry; CONSP (tail2); tail2 = XCDR (tail2))
  5690         XSETCAR (tail2, Fdowncase (XCAR (tail2)));
  5691     }
  5692   Vface_alternative_font_registry_alist = alist;
  5693   free_all_realized_faces (Qnil);
  5694   return alist;
  5695 }
  5696 
  5697 
  5698 #ifdef HAVE_WINDOW_SYSTEM
  5699 
  5700 /* Return the fontset id of the base fontset name or alias name given
  5701    by the fontset attribute of ATTRS.  Value is -1 if the fontset
  5702    attribute of ATTRS doesn't name a fontset.  */
  5703 
  5704 static int
  5705 face_fontset (Lisp_Object attrs[LFACE_VECTOR_SIZE])
  5706 {
  5707   Lisp_Object name;
  5708 
  5709   name = attrs[LFACE_FONTSET_INDEX];
  5710   if (!STRINGP (name))
  5711     return -1;
  5712   return fs_query_fontset (name, 0);
  5713 }
  5714 
  5715 #endif /* HAVE_WINDOW_SYSTEM */
  5716 
  5717 
  5718 
  5719 /***********************************************************************
  5720                            Face Realization
  5721  ***********************************************************************/
  5722 
  5723 /* Realize basic faces on frame F.  Value is zero if frame parameters
  5724    of F don't contain enough information needed to realize the default
  5725    face.  */
  5726 
  5727 static bool
  5728 realize_basic_faces (struct frame *f)
  5729 {
  5730   bool success_p = false;
  5731 
  5732   /* Block input here so that we won't be surprised by an X expose
  5733      event, for instance, without having the faces set up.  */
  5734   block_input ();
  5735 
  5736   if (realize_default_face (f))
  5737     {
  5738       realize_named_face (f, Qmode_line_active, MODE_LINE_ACTIVE_FACE_ID);
  5739       realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID);
  5740       realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID);
  5741       realize_named_face (f, Qfringe, FRINGE_FACE_ID);
  5742       realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID);
  5743       realize_named_face (f, Qscroll_bar, SCROLL_BAR_FACE_ID);
  5744       realize_named_face (f, Qborder, BORDER_FACE_ID);
  5745       realize_named_face (f, Qcursor, CURSOR_FACE_ID);
  5746       realize_named_face (f, Qmouse, MOUSE_FACE_ID);
  5747       realize_named_face (f, Qmenu, MENU_FACE_ID);
  5748       realize_named_face (f, Qvertical_border, VERTICAL_BORDER_FACE_ID);
  5749       realize_named_face (f, Qwindow_divider, WINDOW_DIVIDER_FACE_ID);
  5750       realize_named_face (f, Qwindow_divider_first_pixel,
  5751                           WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID);
  5752       realize_named_face (f, Qwindow_divider_last_pixel,
  5753                           WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
  5754       realize_named_face (f, Qinternal_border, INTERNAL_BORDER_FACE_ID);
  5755       realize_named_face (f, Qchild_frame_border, CHILD_FRAME_BORDER_FACE_ID);
  5756       realize_named_face (f, Qtab_bar, TAB_BAR_FACE_ID);
  5757       realize_named_face (f, Qtab_line, TAB_LINE_FACE_ID);
  5758 
  5759       /* Reflect changes in the `menu' face in menu bars.  */
  5760       if (FRAME_FACE_CACHE (f)->menu_face_changed_p)
  5761         {
  5762           FRAME_FACE_CACHE (f)->menu_face_changed_p = false;
  5763 #ifdef USE_X_TOOLKIT
  5764           if (FRAME_WINDOW_P (f))
  5765             x_update_menu_appearance (f);
  5766 #endif
  5767         }
  5768 
  5769       success_p = true;
  5770     }
  5771 
  5772   unblock_input ();
  5773   return success_p;
  5774 }
  5775 
  5776 
  5777 /* Realize the default face on frame F.  If the face is not fully
  5778    specified, make it fully-specified.  Attributes of the default face
  5779    that are not explicitly specified are taken from frame parameters.  */
  5780 
  5781 static bool
  5782 realize_default_face (struct frame *f)
  5783 {
  5784   struct face_cache *c = FRAME_FACE_CACHE (f);
  5785   Lisp_Object lface;
  5786   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  5787 
  5788   /* If the `default' face is not yet known, create it.  */
  5789   lface = lface_from_face_name (f, Qdefault, false);
  5790   if (NILP (lface))
  5791     {
  5792        Lisp_Object frame;
  5793        XSETFRAME (frame, f);
  5794        lface = Finternal_make_lisp_face (Qdefault, frame);
  5795     }
  5796 
  5797 #ifdef HAVE_WINDOW_SYSTEM
  5798   if (FRAME_WINDOW_P (f))
  5799     {
  5800       Lisp_Object font_object;
  5801 
  5802       XSETFONT (font_object, FRAME_FONT (f));
  5803       set_lface_from_font (f, lface, font_object, f->default_face_done_p);
  5804       ASET (lface, LFACE_FONTSET_INDEX, fontset_name (FRAME_FONTSET (f)));
  5805       f->default_face_done_p = true;
  5806     }
  5807 #endif /* HAVE_WINDOW_SYSTEM */
  5808 
  5809   if (!FRAME_WINDOW_P (f))
  5810     {
  5811       ASET (lface, LFACE_FAMILY_INDEX, build_string ("default"));
  5812       ASET (lface, LFACE_FOUNDRY_INDEX, LFACE_FAMILY (lface));
  5813       ASET (lface, LFACE_SWIDTH_INDEX, Qnormal);
  5814       ASET (lface, LFACE_HEIGHT_INDEX, make_fixnum (1));
  5815       if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
  5816         ASET (lface, LFACE_WEIGHT_INDEX, Qnormal);
  5817       if (UNSPECIFIEDP (LFACE_SLANT (lface)))
  5818         ASET (lface, LFACE_SLANT_INDEX, Qnormal);
  5819       if (UNSPECIFIEDP (LFACE_FONTSET (lface)))
  5820         ASET (lface, LFACE_FONTSET_INDEX, Qnil);
  5821     }
  5822 
  5823   if (UNSPECIFIEDP (LFACE_EXTEND (lface)))
  5824     ASET (lface, LFACE_EXTEND_INDEX, Qnil);
  5825 
  5826   if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
  5827     ASET (lface, LFACE_UNDERLINE_INDEX, Qnil);
  5828 
  5829   if (UNSPECIFIEDP (LFACE_OVERLINE (lface)))
  5830     ASET (lface, LFACE_OVERLINE_INDEX, Qnil);
  5831 
  5832   if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface)))
  5833     ASET (lface, LFACE_STRIKE_THROUGH_INDEX, Qnil);
  5834 
  5835   if (UNSPECIFIEDP (LFACE_BOX (lface)))
  5836     ASET (lface, LFACE_BOX_INDEX, Qnil);
  5837 
  5838   if (UNSPECIFIEDP (LFACE_INVERSE (lface)))
  5839     ASET (lface, LFACE_INVERSE_INDEX, Qnil);
  5840 
  5841   if (UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
  5842     {
  5843       /* This function is called so early that colors are not yet
  5844          set in the frame parameter list.  */
  5845       Lisp_Object color = Fassq (Qforeground_color, f->param_alist);
  5846 
  5847       if (CONSP (color) && STRINGP (XCDR (color)))
  5848         ASET (lface, LFACE_FOREGROUND_INDEX, XCDR (color));
  5849       else if (FRAME_WINDOW_P (f))
  5850         return false;
  5851       else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
  5852         ASET (lface, LFACE_FOREGROUND_INDEX, build_string (unspecified_fg));
  5853       else
  5854         emacs_abort ();
  5855     }
  5856 
  5857   if (UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
  5858     {
  5859       /* This function is called so early that colors are not yet
  5860          set in the frame parameter list.  */
  5861       Lisp_Object color = Fassq (Qbackground_color, f->param_alist);
  5862       if (CONSP (color) && STRINGP (XCDR (color)))
  5863         ASET (lface, LFACE_BACKGROUND_INDEX, XCDR (color));
  5864       else if (FRAME_WINDOW_P (f))
  5865         return false;
  5866       else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
  5867         ASET (lface, LFACE_BACKGROUND_INDEX, build_string (unspecified_bg));
  5868       else
  5869         emacs_abort ();
  5870     }
  5871 
  5872   if (UNSPECIFIEDP (LFACE_STIPPLE (lface)))
  5873     ASET (lface, LFACE_STIPPLE_INDEX, Qnil);
  5874 
  5875   /* Realize the face; it must be fully-specified now.  */
  5876   eassert (lface_fully_specified_p (XVECTOR (lface)->contents));
  5877   check_lface (lface);
  5878   memcpy (attrs, xvector_contents (lface), sizeof attrs);
  5879   struct face *face = realize_face (c, attrs, DEFAULT_FACE_ID);
  5880 
  5881 #ifndef HAVE_WINDOW_SYSTEM
  5882   (void) face;
  5883 #else
  5884   if (FRAME_X_P (f) && face->font != FRAME_FONT (f))
  5885     {
  5886       /* This can happen when making a frame on a display that does
  5887          not support the default font.  */
  5888       if (!face->font)
  5889         return false;
  5890 
  5891       /* Otherwise, the font specified for the frame was not
  5892          acceptable as a font for the default face (perhaps because
  5893          auto-scaled fonts are rejected), so we must adjust the frame
  5894          font.  */
  5895       gui_set_font (f, LFACE_FONT (lface), Qnil);
  5896     }
  5897 #endif
  5898   return true;
  5899 }
  5900 
  5901 
  5902 /* Realize basic faces other than the default face in face cache C.
  5903    SYMBOL is the face name, ID is the face id the realized face must
  5904    have.  The default face must have been realized already.  */
  5905 
  5906 static void
  5907 realize_named_face (struct frame *f, Lisp_Object symbol, int id)
  5908 {
  5909   struct face_cache *c = FRAME_FACE_CACHE (f);
  5910   Lisp_Object lface = lface_from_face_name (f, symbol, false);
  5911   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  5912   Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
  5913 
  5914   /* The default face must exist and be fully specified.  */
  5915   get_lface_attributes_no_remap (f, Qdefault, attrs, true);
  5916   check_lface_attrs (attrs);
  5917   eassert (lface_fully_specified_p (attrs));
  5918 
  5919   /* If SYMBOL isn't know as a face, create it.  */
  5920   if (NILP (lface))
  5921     {
  5922       Lisp_Object frame;
  5923       XSETFRAME (frame, f);
  5924       lface = Finternal_make_lisp_face (symbol, frame);
  5925     }
  5926 
  5927 
  5928   get_lface_attributes_no_remap (f, symbol, symbol_attrs, true);
  5929 
  5930   /* Handle the 'reset' pseudo-value of any attribute by replacing it
  5931      with the corresponding value of the default face.  */
  5932   int i;
  5933   for (i = 1; i < LFACE_VECTOR_SIZE; i++)
  5934     if (EQ (symbol_attrs[i], Qreset))
  5935       symbol_attrs[i] = attrs[i];
  5936   /* Merge SYMBOL's face with the default face.  */
  5937   merge_face_vectors (NULL, f, symbol_attrs, attrs, 0);
  5938 
  5939   /* Realize the face.  */
  5940   realize_face (c, attrs, id);
  5941 }
  5942 
  5943 
  5944 /* Realize the fully-specified face with attributes ATTRS in face
  5945    cache CACHE for ASCII characters.  If FORMER_FACE_ID is
  5946    non-negative, it is an ID of face to remove before caching the new
  5947    face.  Value is a pointer to the newly created realized face.  */
  5948 
  5949 static struct face *
  5950 realize_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE],
  5951               int former_face_id)
  5952 {
  5953   struct face *face;
  5954 
  5955   /* LFACE must be fully specified.  */
  5956   eassert (cache != NULL);
  5957   check_lface_attrs (attrs);
  5958 
  5959   if (former_face_id >= 0 && cache->used > former_face_id)
  5960     {
  5961       /* Remove the former face.  */
  5962       struct face *former_face = cache->faces_by_id[former_face_id];
  5963       uncache_face (cache, former_face);
  5964       free_realized_face (cache->f, former_face);
  5965       SET_FRAME_GARBAGED (cache->f);
  5966     }
  5967 
  5968   if (FRAME_WINDOW_P (cache->f))
  5969     face = realize_gui_face (cache, attrs);
  5970   else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
  5971     face = realize_tty_face (cache, attrs);
  5972   else if (FRAME_INITIAL_P (cache->f))
  5973     {
  5974       /* Create a dummy face. */
  5975       face = make_realized_face (attrs);
  5976     }
  5977   else
  5978     emacs_abort ();
  5979 
  5980   /* Insert the new face.  */
  5981   cache_face (cache, face, lface_hash (attrs));
  5982   return face;
  5983 }
  5984 
  5985 
  5986 #ifdef HAVE_WINDOW_SYSTEM
  5987 /* Realize the fully-specified face that uses FONT-OBJECT and has the
  5988    same attributes as BASE_FACE except for the font on frame F.
  5989    FONT-OBJECT may be nil, in which case, realized a face of
  5990    no-font.  */
  5991 
  5992 static struct face *
  5993 realize_non_ascii_face (struct frame *f, Lisp_Object font_object,
  5994                         struct face *base_face)
  5995 {
  5996   struct face_cache *cache = FRAME_FACE_CACHE (f);
  5997   struct face *face;
  5998 
  5999   face = xmalloc (sizeof *face);
  6000   *face = *base_face;
  6001   face->gc = 0;
  6002   face->overstrike
  6003     = (! NILP (font_object)
  6004        && FONT_WEIGHT_NAME_NUMERIC (face->lface[LFACE_WEIGHT_INDEX]) > 100
  6005        && FONT_WEIGHT_NUMERIC (font_object) <= 100);
  6006 
  6007   /* Don't try to free the colors copied bitwise from BASE_FACE.  */
  6008   face->colors_copied_bitwise_p = true;
  6009   face->font = NILP (font_object) ? NULL : XFONT_OBJECT (font_object);
  6010   face->gc = 0;
  6011 
  6012   cache_face (cache, face, face->hash);
  6013 
  6014   return face;
  6015 }
  6016 
  6017 /* Remove the attribute at INDEX from the font object if SYMBOL
  6018    appears in `font-fallback-ignored-attributes'.  */
  6019 
  6020 static void
  6021 font_maybe_unset_attribute (Lisp_Object font_object,
  6022                             enum font_property_index index, Lisp_Object symbol)
  6023 {
  6024   Lisp_Object tail = Vface_font_lax_matched_attributes;
  6025 
  6026   eassert (CONSP (tail));
  6027 
  6028   FOR_EACH_TAIL_SAFE (tail)
  6029     {
  6030       if (EQ (XCAR (tail), symbol))
  6031         ASET (font_object, index, Qnil);
  6032     }
  6033 }
  6034 #endif /* HAVE_WINDOW_SYSTEM */
  6035 
  6036 /* Realize the fully-specified face with attributes ATTRS in face
  6037    cache CACHE for ASCII characters.  Do it for GUI frame CACHE->f.
  6038    If the new face doesn't share font with the default face, a
  6039    fontname is allocated from the heap and set in `font_name' of the
  6040    new face, but it is not yet loaded here.  Value is a pointer to the
  6041    newly created realized face.  */
  6042 
  6043 static struct face *
  6044 realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE])
  6045 {
  6046   struct face *face = NULL;
  6047 #ifdef HAVE_WINDOW_SYSTEM
  6048   struct face *default_face;
  6049   struct frame *f;
  6050   Lisp_Object stipple, underline, overline, strike_through, box;
  6051 
  6052   eassert (FRAME_WINDOW_P (cache->f));
  6053 
  6054   /* Allocate a new realized face.  */
  6055   face = make_realized_face (attrs);
  6056   face->ascii_face = face;
  6057 
  6058   f = cache->f;
  6059 
  6060   /* Determine the font to use.  Most of the time, the font will be
  6061      the same as the font of the default face, so try that first.  */
  6062   default_face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
  6063   if (default_face
  6064       && lface_same_font_attributes_p (default_face->lface, attrs))
  6065     {
  6066       face->font = default_face->font;
  6067       face->fontset
  6068         = make_fontset_for_ascii_face (f, default_face->fontset, face);
  6069     }
  6070   else
  6071     {
  6072       /* If the face attribute ATTRS specifies a fontset, use it as
  6073          the base of a new realized fontset.  Otherwise, use the same
  6074          base fontset as of the default face.  The base determines
  6075          registry and encoding of a font.  It may also determine
  6076          foundry and family.  The other fields of font name pattern
  6077          are constructed from ATTRS.  */
  6078       int fontset = face_fontset (attrs);
  6079 
  6080       /* If we are realizing the default face, ATTRS should specify a
  6081          fontset.  In other words, if FONTSET is -1, we are not
  6082          realizing the default face, thus the default face should have
  6083          already been realized.  */
  6084       if (fontset == -1)
  6085         {
  6086           if (default_face)
  6087             fontset = default_face->fontset;
  6088           if (fontset == -1)
  6089             emacs_abort ();
  6090         }
  6091       if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
  6092         {
  6093           Lisp_Object spec = copy_font_spec (attrs[LFACE_FONT_INDEX]);
  6094 
  6095           /* Maybe unset several values in SPEC, usually the width,
  6096              slant, and weight.  The best possible values for these
  6097              attributes are determined in font_find_for_lface, called
  6098              by font_load_for_lface, when the list of candidate fonts
  6099              returned by font_list_entities is sorted by font_select_entity
  6100              (which calls font_sort_entities, which calls font_score).
  6101              If these attributes are not unset here, the candidate
  6102              font list returned by font_list_entities only contains
  6103              fonts that are exact matches for these weight, slant, and
  6104              width attributes, which could lead to suboptimal or wrong
  6105              font selection.  (bug#5934) */
  6106           if (EQ (Vface_font_lax_matched_attributes, Qt))
  6107             {
  6108               /* The default case: clear the font attributes that
  6109                  affect its appearance the least, to try to find some
  6110                  font that is close, if not exact, match.  */
  6111               ASET (spec, FONT_WEIGHT_INDEX, Qnil);
  6112               ASET (spec, FONT_SLANT_INDEX, Qnil);
  6113               ASET (spec, FONT_WIDTH_INDEX, Qnil);
  6114             }
  6115           else if (!NILP (Vface_font_lax_matched_attributes))
  6116             {
  6117               /* Also allow unsetting specific attributes for
  6118                  debugging purposes.  */
  6119               font_maybe_unset_attribute (spec, FONT_WEIGHT_INDEX, QCweight);
  6120               font_maybe_unset_attribute (spec, FONT_SLANT_INDEX, QCslant);
  6121               font_maybe_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth);
  6122               font_maybe_unset_attribute (spec, FONT_FAMILY_INDEX, QCfamily);
  6123               font_maybe_unset_attribute (spec, FONT_FOUNDRY_INDEX, QCfoundry);
  6124               font_maybe_unset_attribute (spec, FONT_REGISTRY_INDEX, QCregistry);
  6125               font_maybe_unset_attribute (spec, FONT_ADSTYLE_INDEX, QCadstyle);
  6126               font_maybe_unset_attribute (spec, FONT_SIZE_INDEX, QCsize);
  6127               font_maybe_unset_attribute (spec, FONT_DPI_INDEX, QCdpi);
  6128               font_maybe_unset_attribute (spec, FONT_SPACING_INDEX, QCspacing);
  6129               font_maybe_unset_attribute (spec, FONT_AVGWIDTH_INDEX, QCavgwidth);
  6130             }
  6131 
  6132           attrs[LFACE_FONT_INDEX] = font_load_for_lface (f, attrs, spec);
  6133         }
  6134       if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
  6135         {
  6136           face->font = XFONT_OBJECT (attrs[LFACE_FONT_INDEX]);
  6137           face->fontset = make_fontset_for_ascii_face (f, fontset, face);
  6138         }
  6139       else
  6140         {
  6141           face->font = NULL;
  6142           face->fontset = -1;
  6143         }
  6144     }
  6145 
  6146   if (face->font
  6147       && FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]) > 100
  6148       && FONT_WEIGHT_NUMERIC (attrs[LFACE_FONT_INDEX]) <= 100)
  6149     face->overstrike = true;
  6150 
  6151   /* Load colors, and set remaining attributes.  */
  6152 
  6153   load_face_colors (f, face, attrs);
  6154 
  6155   /* Set up box.  */
  6156   box = attrs[LFACE_BOX_INDEX];
  6157   if (STRINGP (box))
  6158     {
  6159       /* A simple box of line width 1 drawn in color given by
  6160          the string.  */
  6161       face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX],
  6162                                     LFACE_BOX_INDEX);
  6163       face->box = FACE_SIMPLE_BOX;
  6164       face->box_vertical_line_width = face->box_horizontal_line_width = 1;
  6165     }
  6166   else if (FIXNUMP (box))
  6167     {
  6168       /* Simple box of specified line width in foreground color of the
  6169          face.  */
  6170       eassert (XFIXNUM (box) != 0);
  6171       face->box = FACE_SIMPLE_BOX;
  6172       face->box_vertical_line_width = eabs(XFIXNUM (box));
  6173       face->box_horizontal_line_width = XFIXNUM (box);
  6174       face->box_color = face->foreground;
  6175       face->box_color_defaulted_p = true;
  6176     }
  6177   else if (CONSP (box) && FIXNUMP (XCAR (box)) && FIXNUMP (XCDR (box)))
  6178     {
  6179         /* `(VWIDTH . HWIDTH)'.  */
  6180       face->box = FACE_SIMPLE_BOX;
  6181       face->box_color = face->foreground;
  6182       face->box_color_defaulted_p = true;
  6183       face->box_vertical_line_width = XFIXNUM (XCAR (box));
  6184       face->box_horizontal_line_width = XFIXNUM (XCDR (box));
  6185     }
  6186   else if (CONSP (box))
  6187     {
  6188       bool set_color = false;
  6189 
  6190       /* `(:width WIDTH :color COLOR :shadow SHADOW)'.  SHADOW
  6191          being one of `raised' or `sunken'.  */
  6192       face->box = FACE_SIMPLE_BOX;
  6193       face->box_color = face->foreground;
  6194       face->box_color_defaulted_p = true;
  6195       face->box_vertical_line_width = face->box_horizontal_line_width = 1;
  6196 
  6197       while (CONSP (box))
  6198         {
  6199           Lisp_Object keyword, value;
  6200 
  6201           keyword = XCAR (box);
  6202           box = XCDR (box);
  6203 
  6204           if (!CONSP (box))
  6205             break;
  6206           value = XCAR (box);
  6207           box = XCDR (box);
  6208 
  6209           if (EQ (keyword, QCline_width))
  6210             {
  6211               if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR (value))) {
  6212                   face->box_vertical_line_width = XFIXNUM (XCAR (value));
  6213                   face->box_horizontal_line_width = XFIXNUM (XCDR (value));
  6214               }
  6215               else if (FIXNUMP (value) && XFIXNUM (value) != 0) {
  6216                 face->box_vertical_line_width = eabs (XFIXNUM (value));
  6217                 face->box_horizontal_line_width = XFIXNUM (value);
  6218               }
  6219             }
  6220           else if (EQ (keyword, QCcolor))
  6221             {
  6222               if (STRINGP (value))
  6223                 {
  6224                   face->box_color = load_color (f, face, value,
  6225                                                 LFACE_BOX_INDEX);
  6226                   face->use_box_color_for_shadows_p = true;
  6227                   set_color = true;
  6228                 }
  6229             }
  6230           else if (EQ (keyword, QCstyle))
  6231             {
  6232               if (EQ (value, Qreleased_button))
  6233                 face->box = FACE_RAISED_BOX;
  6234               else if (EQ (value, Qpressed_button))
  6235                 face->box = FACE_SUNKEN_BOX;
  6236               else if (EQ (value, Qflat_button))
  6237                 {
  6238                   face->box = FACE_SIMPLE_BOX;
  6239                   /* Don't override colors set in this box. */
  6240                   if (!set_color)
  6241                     face->box_color = face->background;
  6242                 }
  6243             }
  6244         }
  6245     }
  6246 
  6247   /* Text underline, overline, strike-through.  */
  6248 
  6249   underline = attrs[LFACE_UNDERLINE_INDEX];
  6250   if (EQ (underline, Qt))
  6251     {
  6252       /* Use default color (same as foreground color).  */
  6253       face->underline = FACE_UNDER_LINE;
  6254       face->underline_defaulted_p = true;
  6255       face->underline_color = 0;
  6256       face->underline_at_descent_line_p = false;
  6257       face->underline_pixels_above_descent_line = 0;
  6258     }
  6259   else if (STRINGP (underline))
  6260     {
  6261       /* Use specified color.  */
  6262       face->underline = FACE_UNDER_LINE;
  6263       face->underline_defaulted_p = false;
  6264       face->underline_color
  6265         = load_color (f, face, underline,
  6266                       LFACE_UNDERLINE_INDEX);
  6267       face->underline_at_descent_line_p = false;
  6268       face->underline_pixels_above_descent_line = 0;
  6269     }
  6270   else if (NILP (underline))
  6271     {
  6272       face->underline = FACE_NO_UNDERLINE;
  6273       face->underline_defaulted_p = false;
  6274       face->underline_color = 0;
  6275       face->underline_at_descent_line_p = false;
  6276       face->underline_pixels_above_descent_line = 0;
  6277     }
  6278   else if (CONSP (underline))
  6279     {
  6280       /* `(:color COLOR :style STYLE)'.
  6281          STYLE being one of `line' or `wave'. */
  6282       face->underline = FACE_UNDER_LINE;
  6283       face->underline_color = 0;
  6284       face->underline_defaulted_p = true;
  6285       face->underline_at_descent_line_p = false;
  6286       face->underline_pixels_above_descent_line = 0;
  6287 
  6288       /* FIXME?  This is also not robust about checking the precise form.
  6289          See comments in Finternal_set_lisp_face_attribute.  */
  6290       while (CONSP (underline))
  6291         {
  6292           Lisp_Object keyword, value;
  6293 
  6294           keyword = XCAR (underline);
  6295           underline = XCDR (underline);
  6296 
  6297           if (!CONSP (underline))
  6298             break;
  6299           value = XCAR (underline);
  6300           underline = XCDR (underline);
  6301 
  6302           if (EQ (keyword, QCcolor))
  6303             {
  6304               if (EQ (value, Qforeground_color))
  6305                 {
  6306                   face->underline_defaulted_p = true;
  6307                   face->underline_color = 0;
  6308                 }
  6309               else if (STRINGP (value))
  6310                 {
  6311                   face->underline_defaulted_p = false;
  6312                   face->underline_color = load_color (f, face, value,
  6313                                                       LFACE_UNDERLINE_INDEX);
  6314                 }
  6315             }
  6316           else if (EQ (keyword, QCstyle))
  6317             {
  6318               if (EQ (value, Qline))
  6319                 face->underline = FACE_UNDER_LINE;
  6320               else if (EQ (value, Qwave))
  6321                 face->underline = FACE_UNDER_WAVE;
  6322             }
  6323           else if (EQ (keyword, QCposition))
  6324             {
  6325               face->underline_at_descent_line_p = !NILP (value);
  6326 
  6327               if (FIXNATP (value))
  6328                 face->underline_pixels_above_descent_line = XFIXNAT (value);
  6329             }
  6330         }
  6331     }
  6332 
  6333   overline = attrs[LFACE_OVERLINE_INDEX];
  6334   if (STRINGP (overline))
  6335     {
  6336       face->overline_color
  6337         = load_color (f, face, attrs[LFACE_OVERLINE_INDEX],
  6338                       LFACE_OVERLINE_INDEX);
  6339       face->overline_p = true;
  6340     }
  6341   else if (EQ (overline, Qt))
  6342     {
  6343       face->overline_color = face->foreground;
  6344       face->overline_color_defaulted_p = true;
  6345       face->overline_p = true;
  6346     }
  6347 
  6348   strike_through = attrs[LFACE_STRIKE_THROUGH_INDEX];
  6349   if (STRINGP (strike_through))
  6350     {
  6351       face->strike_through_color
  6352         = load_color (f, face, attrs[LFACE_STRIKE_THROUGH_INDEX],
  6353                       LFACE_STRIKE_THROUGH_INDEX);
  6354       face->strike_through_p = true;
  6355     }
  6356   else if (EQ (strike_through, Qt))
  6357     {
  6358       face->strike_through_color = face->foreground;
  6359       face->strike_through_color_defaulted_p = true;
  6360       face->strike_through_p = true;
  6361     }
  6362 
  6363   stipple = attrs[LFACE_STIPPLE_INDEX];
  6364   if (!NILP (stipple))
  6365     face->stipple = load_pixmap (f, stipple);
  6366 #endif /* HAVE_WINDOW_SYSTEM */
  6367 
  6368   return face;
  6369 }
  6370 
  6371 
  6372 /* Map a specified color of face FACE on frame F to a tty color index.
  6373    IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
  6374    specifies which color to map.  Set *DEFAULTED to true if mapping to the
  6375    default foreground/background colors.  */
  6376 
  6377 static void
  6378 map_tty_color (struct frame *f, struct face *face,
  6379                enum lface_attribute_index idx, bool *defaulted)
  6380 {
  6381   Lisp_Object frame, color, def;
  6382   bool foreground_p = idx == LFACE_FOREGROUND_INDEX;
  6383   unsigned long default_pixel =
  6384     foreground_p ? FACE_TTY_DEFAULT_FG_COLOR : FACE_TTY_DEFAULT_BG_COLOR;
  6385   unsigned long pixel = default_pixel;
  6386 #ifdef MSDOS
  6387   unsigned long default_other_pixel =
  6388     foreground_p ? FACE_TTY_DEFAULT_BG_COLOR : FACE_TTY_DEFAULT_FG_COLOR;
  6389 #endif
  6390 
  6391   eassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
  6392 
  6393   XSETFRAME (frame, f);
  6394   color = face->lface[idx];
  6395 
  6396   if (STRINGP (color)
  6397       && SCHARS (color)
  6398       && CONSP (Vtty_defined_color_alist)
  6399       && (def = assoc_no_quit (color, call1 (Qtty_color_alist, frame)),
  6400           CONSP (def)))
  6401     {
  6402       /* Associations in tty-defined-color-alist are of the form
  6403          (NAME INDEX R G B).  We need the INDEX part.  */
  6404       pixel = XFIXNUM (XCAR (XCDR (def)));
  6405     }
  6406 
  6407   if (pixel == default_pixel && STRINGP (color))
  6408     {
  6409       pixel = load_color (f, face, color, idx);
  6410 
  6411 #ifdef MSDOS
  6412       /* If the foreground of the default face is the default color,
  6413          use the foreground color defined by the frame.  */
  6414       if (FRAME_MSDOS_P (f))
  6415         {
  6416           if (pixel == default_pixel
  6417               || pixel == FACE_TTY_DEFAULT_COLOR)
  6418             {
  6419               if (foreground_p)
  6420                 pixel = FRAME_FOREGROUND_PIXEL (f);
  6421               else
  6422                 pixel = FRAME_BACKGROUND_PIXEL (f);
  6423               face->lface[idx] = tty_color_name (f, pixel);
  6424               *defaulted = true;
  6425             }
  6426           else if (pixel == default_other_pixel)
  6427             {
  6428               if (foreground_p)
  6429                 pixel = FRAME_BACKGROUND_PIXEL (f);
  6430               else
  6431                 pixel = FRAME_FOREGROUND_PIXEL (f);
  6432               face->lface[idx] = tty_color_name (f, pixel);
  6433               *defaulted = true;
  6434             }
  6435         }
  6436 #endif /* MSDOS */
  6437     }
  6438 
  6439   if (foreground_p)
  6440     face->foreground = pixel;
  6441   else
  6442     face->background = pixel;
  6443 }
  6444 
  6445 
  6446 /* Realize the fully-specified face with attributes ATTRS in face
  6447    cache CACHE for ASCII characters.  Do it for TTY frame CACHE->f.
  6448    Value is a pointer to the newly created realized face.  */
  6449 
  6450 static struct face *
  6451 realize_tty_face (struct face_cache *cache,
  6452                   Lisp_Object attrs[LFACE_VECTOR_SIZE])
  6453 {
  6454   struct face *face;
  6455   int weight, slant;
  6456   bool face_colors_defaulted = false;
  6457   struct frame *f = cache->f;
  6458 
  6459   /* Frame must be a termcap frame.  */
  6460   eassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
  6461 
  6462   /* Allocate a new realized face.  */
  6463   face = make_realized_face (attrs);
  6464 #if false
  6465   face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
  6466 #endif
  6467 
  6468   /* Map face attributes to TTY appearances.  */
  6469   weight = FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]);
  6470   slant = FONT_SLANT_NAME_NUMERIC (attrs[LFACE_SLANT_INDEX]);
  6471   if (weight > 100)
  6472     face->tty_bold_p = true;
  6473   if (slant != 100)
  6474     face->tty_italic_p = true;
  6475   if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
  6476     face->tty_underline_p = true;
  6477   if (!NILP (attrs[LFACE_INVERSE_INDEX]))
  6478     face->tty_reverse_p = true;
  6479   if (!NILP (attrs[LFACE_STRIKE_THROUGH_INDEX]))
  6480     face->tty_strike_through_p = true;
  6481 
  6482   /* Map color names to color indices.  */
  6483   map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
  6484   map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
  6485 
  6486   /* Swap colors if face is inverse-video.  If the colors are taken
  6487      from the frame colors, they are already inverted, since the
  6488      frame-creation function calls x-handle-reverse-video.  */
  6489   if (face->tty_reverse_p && !face_colors_defaulted)
  6490     {
  6491       unsigned long tem = face->foreground;
  6492       face->foreground = face->background;
  6493       face->background = tem;
  6494     }
  6495 
  6496   if (tty_suppress_bold_inverse_default_colors_p
  6497       && face->tty_bold_p
  6498       && face->background == FACE_TTY_DEFAULT_FG_COLOR
  6499       && face->foreground == FACE_TTY_DEFAULT_BG_COLOR)
  6500     face->tty_bold_p = false;
  6501 
  6502   return face;
  6503 }
  6504 
  6505 
  6506 DEFUN ("tty-suppress-bold-inverse-default-colors",
  6507        Ftty_suppress_bold_inverse_default_colors,
  6508        Stty_suppress_bold_inverse_default_colors, 1, 1, 0,
  6509        doc: /* Suppress/allow boldness of faces with inverse default colors.
  6510 SUPPRESS non-nil means suppress it.
  6511 This affects bold faces on TTYs whose foreground is the default background
  6512 color of the display and whose background is the default foreground color.
  6513 For such faces, the bold face attribute is ignored if this variable
  6514 is non-nil.  */)
  6515   (Lisp_Object suppress)
  6516 {
  6517   tty_suppress_bold_inverse_default_colors_p = !NILP (suppress);
  6518   face_change = true;
  6519   return suppress;
  6520 }
  6521 
  6522 
  6523 
  6524 /***********************************************************************
  6525                            Computing Faces
  6526  ***********************************************************************/
  6527 
  6528 /* Return the ID of the face to use to display character CH with face
  6529    property PROP on frame F in current_buffer.  */
  6530 
  6531 int
  6532 compute_char_face (struct frame *f, int ch, Lisp_Object prop)
  6533 {
  6534   int face_id;
  6535 
  6536   if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  6537     ch = 0;
  6538 
  6539   if (NILP (prop))
  6540     {
  6541       struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  6542       face_id = FACE_FOR_CHAR (f, face, ch, -1, Qnil);
  6543     }
  6544   else
  6545     {
  6546       Lisp_Object attrs[LFACE_VECTOR_SIZE];
  6547       struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  6548       memcpy (attrs, default_face->lface, sizeof attrs);
  6549       merge_face_ref (NULL, f, prop, attrs, true, NULL, 0);
  6550       face_id = lookup_face (f, attrs);
  6551     }
  6552 
  6553   return face_id;
  6554 }
  6555 
  6556 /* Return the face ID associated with buffer position POS for
  6557    displaying ASCII characters.  Return in *ENDPTR the position at
  6558    which a different face is needed, as far as text properties and
  6559    overlays are concerned.  W is a window displaying current_buffer.
  6560 
  6561    ATTR_FILTER is passed merge_face_ref.
  6562 
  6563    REGION_BEG, REGION_END delimit the region, so it can be
  6564    highlighted.
  6565 
  6566    LIMIT is a position not to scan beyond.  That is to limit the time
  6567    this function can take.
  6568 
  6569    If MOUSE, use the character's mouse-face, not its face, and only
  6570    consider the highest-priority source of mouse-face at POS,
  6571    i.e. don't merge different mouse-face values if more than one
  6572    source specifies it.
  6573 
  6574    BASE_FACE_ID, if non-negative, specifies a base face id to use
  6575    instead of DEFAULT_FACE_ID.
  6576 
  6577    The face returned is suitable for displaying ASCII characters.  */
  6578 
  6579 int
  6580 face_at_buffer_position (struct window *w, ptrdiff_t pos,
  6581                          ptrdiff_t *endptr, ptrdiff_t limit,
  6582                          bool mouse, int base_face_id,
  6583                          enum lface_attribute_index attr_filter)
  6584 {
  6585   struct frame *f = XFRAME (w->frame);
  6586   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  6587   Lisp_Object prop, position;
  6588   ptrdiff_t i, noverlays;
  6589   Lisp_Object *overlay_vec;
  6590   ptrdiff_t endpos;
  6591   Lisp_Object propname = mouse ? Qmouse_face : Qface;
  6592   Lisp_Object limit1, end;
  6593   struct face *default_face;
  6594 
  6595   /* W must display the current buffer.  We could write this function
  6596      to use the frame and buffer of W, but right now it doesn't.  */
  6597   /* eassert (XBUFFER (w->contents) == current_buffer); */
  6598 
  6599   XSETFASTINT (position, pos);
  6600 
  6601   endpos = ZV;
  6602 
  6603   /* Get the `face' or `mouse_face' text property at POS, and
  6604      determine the next position at which the property changes.  */
  6605   prop = Fget_text_property (position, propname, w->contents);
  6606   XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
  6607   end = Fnext_single_property_change (position, propname, w->contents, limit1);
  6608   if (FIXNUMP (end))
  6609     endpos = XFIXNUM (end);
  6610 
  6611   /* Look at properties from overlays.  */
  6612   USE_SAFE_ALLOCA;
  6613   {
  6614     ptrdiff_t next_overlay;
  6615     GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay);
  6616     if (next_overlay < endpos)
  6617       endpos = next_overlay;
  6618   }
  6619 
  6620   *endptr = endpos;
  6621 
  6622   {
  6623     int face_id;
  6624 
  6625     if (base_face_id >= 0)
  6626       face_id = base_face_id;
  6627     else if (NILP (Vface_remapping_alist))
  6628       face_id = DEFAULT_FACE_ID;
  6629     else
  6630       face_id = lookup_basic_face (w, f, DEFAULT_FACE_ID);
  6631 
  6632     default_face = FACE_FROM_ID_OR_NULL (f, face_id);
  6633     /* Make sure the default face ID is usable: if someone freed the
  6634        cached faces since we've looked up these faces, we need to look
  6635        them up again.  */
  6636     if (!default_face)
  6637       {
  6638         if (FRAME_FACE_CACHE (f)->used == 0)
  6639           recompute_basic_faces (f);
  6640         default_face = FACE_FROM_ID (f,
  6641                                      lookup_basic_face (w, f, DEFAULT_FACE_ID));
  6642       }
  6643   }
  6644 
  6645   /* Optimize common cases where we can use the default face.  */
  6646   if (noverlays == 0
  6647       && NILP (prop))
  6648     {
  6649       SAFE_FREE ();
  6650       return default_face->id;
  6651     }
  6652 
  6653   /* Begin with attributes from the default face.  */
  6654   memcpy (attrs, default_face->lface, sizeof(attrs));
  6655 
  6656   /* Merge in attributes specified via text properties.  */
  6657   if (!NILP (prop))
  6658     merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
  6659 
  6660   /* Now merge the overlay data.  */
  6661   noverlays = sort_overlays (overlay_vec, noverlays, w);
  6662   /* For mouse-face, we need only the single highest-priority face
  6663      from the overlays, if any.  */
  6664   if (mouse)
  6665     {
  6666       for (prop = Qnil, i = noverlays - 1; i >= 0 && NILP (prop); --i)
  6667         {
  6668           ptrdiff_t oendpos;
  6669 
  6670           prop = Foverlay_get (overlay_vec[i], propname);
  6671           if (!NILP (prop))
  6672             {
  6673               /* Overlays always take priority over text properties,
  6674                  so discard the mouse-face text property, if any, and
  6675                  use the overlay property instead.  */
  6676               memcpy (attrs, default_face->lface, sizeof attrs);
  6677               merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
  6678             }
  6679 
  6680           oendpos = OVERLAY_END (overlay_vec[i]);
  6681           if (oendpos < endpos)
  6682             endpos = oendpos;
  6683         }
  6684     }
  6685   else
  6686     {
  6687       for (i = 0; i < noverlays; i++)
  6688         {
  6689           ptrdiff_t oendpos;
  6690 
  6691           prop = Foverlay_get (overlay_vec[i], propname);
  6692 
  6693           if (!NILP (prop))
  6694             merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
  6695 
  6696           oendpos = OVERLAY_END (overlay_vec[i]);
  6697           if (oendpos < endpos)
  6698             endpos = oendpos;
  6699         }
  6700     }
  6701 
  6702   *endptr = endpos;
  6703 
  6704   SAFE_FREE ();
  6705 
  6706   /* Look up a realized face with the given face attributes,
  6707      or realize a new one for ASCII characters.  */
  6708   return lookup_face (f, attrs);
  6709 }
  6710 
  6711 /* Return the face ID at buffer position POS for displaying ASCII
  6712    characters associated with overlay strings for overlay OVERLAY.
  6713 
  6714    Like face_at_buffer_position except for OVERLAY.  Currently it
  6715    simply disregards the `face' properties of all overlays.  */
  6716 
  6717 int
  6718 face_for_overlay_string (struct window *w, ptrdiff_t pos,
  6719                          ptrdiff_t *endptr, ptrdiff_t limit,
  6720                          bool mouse, Lisp_Object overlay,
  6721                          enum lface_attribute_index attr_filter)
  6722 {
  6723   struct frame *f = XFRAME (w->frame);
  6724   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  6725   Lisp_Object prop, position;
  6726   ptrdiff_t endpos;
  6727   Lisp_Object propname = mouse ? Qmouse_face : Qface;
  6728   Lisp_Object limit1, end;
  6729   struct face *default_face;
  6730 
  6731   /* W must display the current buffer.  We could write this function
  6732      to use the frame and buffer of W, but right now it doesn't.  */
  6733   /* eassert (XBUFFER (w->contents) == current_buffer); */
  6734 
  6735   XSETFASTINT (position, pos);
  6736 
  6737   endpos = ZV;
  6738 
  6739   /* Get the `face' or `mouse_face' text property at POS, and
  6740      determine the next position at which the property changes.  */
  6741   prop = Fget_text_property (position, propname, w->contents);
  6742   XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
  6743   end = Fnext_single_property_change (position, propname, w->contents, limit1);
  6744   if (FIXNUMP (end))
  6745     endpos = XFIXNUM (end);
  6746 
  6747   *endptr = endpos;
  6748 
  6749   /* Optimize common case where we can use the default face.  */
  6750   if (NILP (prop)
  6751       && NILP (Vface_remapping_alist))
  6752     return DEFAULT_FACE_ID;
  6753 
  6754   /* Begin with attributes from the default face.  */
  6755   default_face = FACE_FROM_ID (f, lookup_basic_face (w, f, DEFAULT_FACE_ID));
  6756   memcpy (attrs, default_face->lface, sizeof attrs);
  6757 
  6758   /* Merge in attributes specified via text properties.  */
  6759   if (!NILP (prop))
  6760     merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
  6761 
  6762   *endptr = endpos;
  6763 
  6764   /* Look up a realized face with the given face attributes,
  6765      or realize a new one for ASCII characters.  */
  6766   return lookup_face (f, attrs);
  6767 }
  6768 
  6769 
  6770 /* Compute the face at character position POS in Lisp string STRING on
  6771    window W, for ASCII characters.
  6772 
  6773    If STRING is an overlay string, it comes from position BUFPOS in
  6774    current_buffer, otherwise BUFPOS is zero to indicate that STRING is
  6775    not an overlay string.  W must display the current buffer.
  6776    REGION_BEG and REGION_END give the start and end positions of the
  6777    region; both are -1 if no region is visible.
  6778 
  6779    BASE_FACE_ID is the id of a face to merge with.  For strings coming
  6780    from overlays or the `display' property it is the face at BUFPOS.
  6781 
  6782    If MOUSE_P, use the character's mouse-face, not its face.
  6783 
  6784    Set *ENDPTR to the next position where to check for faces in
  6785    STRING; -1 if the face is constant from POS to the end of the
  6786    string.
  6787 
  6788    Value is the id of the face to use.  The face returned is suitable
  6789    for displaying ASCII characters.  */
  6790 
  6791 int
  6792 face_at_string_position (struct window *w, Lisp_Object string,
  6793                          ptrdiff_t pos, ptrdiff_t bufpos,
  6794                          ptrdiff_t *endptr, enum face_id base_face_id,
  6795                          bool mouse_p,
  6796                          enum lface_attribute_index attr_filter)
  6797 {
  6798   Lisp_Object prop, position, end, limit;
  6799   struct frame *f = XFRAME (WINDOW_FRAME (w));
  6800   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  6801   struct face *base_face;
  6802   bool multibyte_p = STRING_MULTIBYTE (string);
  6803   Lisp_Object prop_name = mouse_p ? Qmouse_face : Qface;
  6804 
  6805   /* Get the value of the face property at the current position within
  6806      STRING.  Value is nil if there is no face property.  */
  6807   XSETFASTINT (position, pos);
  6808   prop = Fget_text_property (position, prop_name, string);
  6809 
  6810   /* Get the next position at which to check for faces.  Value of end
  6811      is nil if face is constant all the way to the end of the string.
  6812      Otherwise it is a string position where to check faces next.
  6813      Limit is the maximum position up to which to check for property
  6814      changes in Fnext_single_property_change.  Strings are usually
  6815      short, so set the limit to the end of the string.  */
  6816   XSETFASTINT (limit, SCHARS (string));
  6817   end = Fnext_single_property_change (position, prop_name, string, limit);
  6818   if (FIXNUMP (end))
  6819     *endptr = XFIXNAT (end);
  6820   else
  6821     *endptr = -1;
  6822 
  6823   base_face = FACE_FROM_ID_OR_NULL (f, base_face_id);
  6824   if (!base_face)
  6825     base_face = FACE_FROM_ID (f, lookup_basic_face (w, f, DEFAULT_FACE_ID));
  6826 
  6827   /* Optimize the default case that there is no face property.  */
  6828   if (NILP (prop)
  6829       && (multibyte_p
  6830           /* We can't realize faces for different charsets differently
  6831              if we don't have fonts, so we can stop here if not working
  6832              on a window-system frame.  */
  6833           || !FRAME_WINDOW_P (f)
  6834           || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face)))
  6835     return base_face->id;
  6836 
  6837   /* Begin with attributes from the base face.  */
  6838   memcpy (attrs, base_face->lface, sizeof attrs);
  6839 
  6840   /* Merge in attributes specified via text properties.  */
  6841   if (!NILP (prop))
  6842     merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
  6843 
  6844   /* Look up a realized face with the given face attributes,
  6845      or realize a new one for ASCII characters.  */
  6846   return lookup_face (f, attrs);
  6847 }
  6848 
  6849 
  6850 /* Merge a face into a realized face.
  6851 
  6852    W is a window in the frame where faces are (to be) realized.
  6853 
  6854    FACE_NAME is named face to merge.
  6855 
  6856    If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
  6857 
  6858    If FACE_NAME is t, FACE_ID is lface_id of face to merge.
  6859 
  6860    BASE_FACE_ID is realized face to merge into.
  6861 
  6862    Return new face id.
  6863 */
  6864 
  6865 int
  6866 merge_faces (struct window *w, Lisp_Object face_name, int face_id,
  6867              int base_face_id)
  6868 {
  6869   struct frame *f = WINDOW_XFRAME (w);
  6870   Lisp_Object attrs[LFACE_VECTOR_SIZE];
  6871   struct face *base_face = FACE_FROM_ID_OR_NULL (f, base_face_id);
  6872 
  6873   if (!base_face)
  6874     return base_face_id;
  6875 
  6876   if (EQ (face_name, Qt))
  6877     {
  6878       if (face_id < 0 || face_id >= lface_id_to_name_size)
  6879         return base_face_id;
  6880       face_name = lface_id_to_name[face_id];
  6881       /* When called during make-frame, lookup_derived_face may fail
  6882          if the faces are uninitialized.  Don't signal an error.  */
  6883       face_id = lookup_derived_face (w, f, face_name, base_face_id, 0);
  6884       return (face_id >= 0 ? face_id : base_face_id);
  6885     }
  6886 
  6887   /* Begin with attributes from the base face.  */
  6888   memcpy (attrs, base_face->lface, sizeof attrs);
  6889 
  6890   if (!NILP (face_name))
  6891     {
  6892       if (!merge_named_face (w, f, face_name, attrs, NULL, 0))
  6893         return base_face_id;
  6894     }
  6895   else
  6896     {
  6897       if (face_id < 0)
  6898         return base_face_id;
  6899 
  6900       struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
  6901 
  6902       if (!face)
  6903         return base_face_id;
  6904 
  6905       if (face_id != DEFAULT_FACE_ID)
  6906         {
  6907           struct face *deflt = FACE_FROM_ID (f, DEFAULT_FACE_ID);
  6908           Lisp_Object lface_attrs[LFACE_VECTOR_SIZE];
  6909           int i;
  6910 
  6911           memcpy (lface_attrs, face->lface, LFACE_VECTOR_SIZE);
  6912           /* Make explicit any attributes whose value is 'reset'.  */
  6913           for (i = 1; i < LFACE_VECTOR_SIZE; i++)
  6914             if (EQ (lface_attrs[i], Qreset))
  6915               lface_attrs[i] = deflt->lface[i];
  6916           merge_face_vectors (w, f, lface_attrs, attrs, 0);
  6917         }
  6918       else
  6919         merge_face_vectors (w, f, face->lface, attrs, 0);
  6920     }
  6921 
  6922   /* Look up a realized face with the given face attributes,
  6923      or realize a new one for ASCII characters.  */
  6924   return lookup_face (f, attrs);
  6925 }
  6926 
  6927 
  6928 
  6929 #ifndef HAVE_X_WINDOWS
  6930 DEFUN ("x-load-color-file", Fx_load_color_file,
  6931        Sx_load_color_file, 1, 1, 0,
  6932        doc: /* Create an alist of color entries from an external file.
  6933 
  6934 The file should define one named RGB color per line like so:
  6935   R G B   name
  6936 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.  */)
  6937   (Lisp_Object filename)
  6938 {
  6939   FILE *fp;
  6940   Lisp_Object cmap = Qnil;
  6941   Lisp_Object abspath;
  6942 
  6943   CHECK_STRING (filename);
  6944   abspath = Fexpand_file_name (filename, Qnil);
  6945 
  6946   block_input ();
  6947   fp = emacs_fopen (SSDATA (abspath), "r" FOPEN_TEXT);
  6948   if (fp)
  6949     {
  6950       char buf[512];
  6951       int red, green, blue;
  6952       int num;
  6953 
  6954       while (fgets (buf, sizeof (buf), fp) != NULL)
  6955         if (sscanf (buf, "%d %d %d %n", &red, &green, &blue, &num) == 3)
  6956           {
  6957 #ifdef HAVE_NTGUI
  6958             int color = RGB (red, green, blue);
  6959 #else
  6960             int color = (red << 16) | (green << 8) | blue;
  6961 #endif
  6962             char *name = buf + num;
  6963             ptrdiff_t len = strlen (name);
  6964             len -= 0 < len && name[len - 1] == '\n';
  6965             cmap = Fcons (Fcons (make_string (name, len), make_fixnum (color)),
  6966                           cmap);
  6967           }
  6968       fclose (fp);
  6969     }
  6970   unblock_input ();
  6971   return cmap;
  6972 }
  6973 #endif
  6974 
  6975 
  6976 /***********************************************************************
  6977                                 Tests
  6978  ***********************************************************************/
  6979 
  6980 #ifdef GLYPH_DEBUG
  6981 
  6982 /* Print the contents of the realized face FACE to stderr.  */
  6983 
  6984 static void
  6985 dump_realized_face (struct face *face)
  6986 {
  6987   fprintf (stderr, "ID: %d\n", face->id);
  6988 #ifdef HAVE_X_WINDOWS
  6989   fprintf (stderr, "gc: %p\n", face->gc);
  6990 #endif
  6991   fprintf (stderr, "foreground: 0x%lx (%s)\n",
  6992            face->foreground,
  6993            SDATA (face->lface[LFACE_FOREGROUND_INDEX]));
  6994   fprintf (stderr, "background: 0x%lx (%s)\n",
  6995            face->background,
  6996            SDATA (face->lface[LFACE_BACKGROUND_INDEX]));
  6997   if (face->font)
  6998     fprintf (stderr, "font_name: %s (%s)\n",
  6999              SDATA (face->font->props[FONT_NAME_INDEX]),
  7000              SDATA (face->lface[LFACE_FAMILY_INDEX]));
  7001 #ifdef HAVE_X_WINDOWS
  7002   fprintf (stderr, "font = %p\n", face->font);
  7003 #endif
  7004   fprintf (stderr, "fontset: %d\n", face->fontset);
  7005   fprintf (stderr, "underline: %d (%s)\n",
  7006            face->underline,
  7007            SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
  7008   fprintf (stderr, "hash: %" PRIuPTR "\n", face->hash);
  7009 }
  7010 
  7011 
  7012 DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: /* */)
  7013   (Lisp_Object n)
  7014 {
  7015   if (NILP (n))
  7016     {
  7017       int i;
  7018 
  7019       fputs ("font selection order: ", stderr);
  7020       for (i = 0; i < ARRAYELTS (font_sort_order); ++i)
  7021         fprintf (stderr, "%d ", font_sort_order[i]);
  7022       putc ('\n', stderr);
  7023 
  7024       fputs ("alternative fonts: ", stderr);
  7025       debug_print (Vface_alternative_font_family_alist);
  7026       putc ('\n', stderr);
  7027 
  7028       for (i = 0; i < FRAME_FACE_CACHE (SELECTED_FRAME ())->used; ++i)
  7029         Fdump_face (make_fixnum (i));
  7030     }
  7031   else
  7032     {
  7033       struct face *face;
  7034       CHECK_FIXNUM (n);
  7035       face = FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), XFIXNUM (n));
  7036       if (face == NULL)
  7037         error ("Not a valid face");
  7038       dump_realized_face (face);
  7039     }
  7040 
  7041   return Qnil;
  7042 }
  7043 
  7044 
  7045 DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
  7046        0, 0, 0, doc: /* */)
  7047   (void)
  7048 {
  7049   fprintf (stderr, "number of colors = %d\n", ncolors_allocated);
  7050   fprintf (stderr, "number of pixmaps = %d\n", npixmaps_allocated);
  7051   fprintf (stderr, "number of GCs = %d\n", ngcs);
  7052   return Qnil;
  7053 }
  7054 
  7055 #endif /* GLYPH_DEBUG */
  7056 
  7057 
  7058 
  7059 /***********************************************************************
  7060                             Initialization
  7061  ***********************************************************************/
  7062 
  7063 /* All the faces defined during loadup are recorded in
  7064    face-new-frame-defaults.  We need to set next_lface_id to the next
  7065    face ID number, so that any new faces defined in this session will
  7066    have face IDs different from those defined during loadup.  We also
  7067    need to set up the lface_id_to_name[] array for the faces that were
  7068    defined during loadup.  */
  7069 void
  7070 init_xfaces (void)
  7071 {
  7072 #ifdef HAVE_PDUMPER
  7073   int nfaces;
  7074 
  7075   if (dumped_with_pdumper_p ())
  7076     {
  7077       nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults));
  7078       if (nfaces > 0)
  7079         {
  7080           /* Allocate the lface_id_to_name[] array.  */
  7081           lface_id_to_name_size = next_lface_id = nfaces;
  7082           lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name);
  7083 
  7084           /* Store the faces.  */
  7085           struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults);
  7086           for (ptrdiff_t idx = 0; idx < nfaces; ++idx)
  7087             {
  7088               Lisp_Object lface = HASH_KEY (table, idx);
  7089               Lisp_Object face_id = CAR (HASH_VALUE (table, idx));
  7090               if (FIXNATP (face_id))
  7091                 {
  7092                   int id = XFIXNAT (face_id);
  7093                   eassert (id >= 0);
  7094                   lface_id_to_name[id] = lface;
  7095                 }
  7096             }
  7097         }
  7098     }
  7099 #endif
  7100 
  7101   face_attr_sym[0] = Qface;
  7102   face_attr_sym[LFACE_FOUNDRY_INDEX] = QCfoundry;
  7103   face_attr_sym[LFACE_SWIDTH_INDEX] = QCwidth;
  7104   face_attr_sym[LFACE_HEIGHT_INDEX] = QCheight;
  7105   face_attr_sym[LFACE_WEIGHT_INDEX] = QCweight;
  7106   face_attr_sym[LFACE_SLANT_INDEX] = QCslant;
  7107   face_attr_sym[LFACE_UNDERLINE_INDEX] = QCunderline;
  7108   face_attr_sym[LFACE_INVERSE_INDEX] = QCinverse_video;
  7109   face_attr_sym[LFACE_FOREGROUND_INDEX] = QCforeground;
  7110   face_attr_sym[LFACE_BACKGROUND_INDEX] = QCbackground;
  7111   face_attr_sym[LFACE_STIPPLE_INDEX] = QCstipple;
  7112   face_attr_sym[LFACE_OVERLINE_INDEX] = QCoverline;
  7113   face_attr_sym[LFACE_STRIKE_THROUGH_INDEX] = QCstrike_through;
  7114   face_attr_sym[LFACE_BOX_INDEX] = QCbox;
  7115   face_attr_sym[LFACE_FONT_INDEX] = QCfont;
  7116   face_attr_sym[LFACE_INHERIT_INDEX] = QCinherit;
  7117   face_attr_sym[LFACE_FONTSET_INDEX] = QCfontset;
  7118   face_attr_sym[LFACE_DISTANT_FOREGROUND_INDEX] = QCdistant_foreground;
  7119   face_attr_sym[LFACE_EXTEND_INDEX] = QCextend;
  7120 }
  7121 
  7122 void
  7123 syms_of_xfaces (void)
  7124 {
  7125   /* The symbols `face' and `mouse-face' used as text properties.  */
  7126   DEFSYM (Qface, "face");
  7127 
  7128   /* Property for basic faces which other faces cannot inherit.  */
  7129   DEFSYM (Qface_no_inherit, "face-no-inherit");
  7130 
  7131   /* Error symbol for wrong_type_argument in load_pixmap.  */
  7132   DEFSYM (Qbitmap_spec_p, "bitmap-spec-p");
  7133 
  7134   /* The name of the function to call when the background of the frame
  7135      has changed, frame_set_background_mode.  */
  7136   DEFSYM (Qframe_set_background_mode, "frame-set-background-mode");
  7137 
  7138   /* Lisp face attribute keywords.  */
  7139   DEFSYM (QCfamily, ":family");
  7140   DEFSYM (QCheight, ":height");
  7141   DEFSYM (QCweight, ":weight");
  7142   DEFSYM (QCslant, ":slant");
  7143   DEFSYM (QCunderline, ":underline");
  7144   DEFSYM (QCinverse_video, ":inverse-video");
  7145   DEFSYM (QCreverse_video, ":reverse-video");
  7146   DEFSYM (QCforeground, ":foreground");
  7147   DEFSYM (QCbackground, ":background");
  7148   DEFSYM (QCstipple, ":stipple");
  7149   DEFSYM (QCwidth, ":width");
  7150   DEFSYM (QCfont, ":font");
  7151   DEFSYM (QCfontset, ":fontset");
  7152   DEFSYM (QCdistant_foreground, ":distant-foreground");
  7153   DEFSYM (QCbold, ":bold");
  7154   DEFSYM (QCitalic, ":italic");
  7155   DEFSYM (QCoverline, ":overline");
  7156   DEFSYM (QCstrike_through, ":strike-through");
  7157   DEFSYM (QCbox, ":box");
  7158   DEFSYM (QCinherit, ":inherit");
  7159   DEFSYM (QCextend, ":extend");
  7160 
  7161   /* Symbols used for Lisp face attribute values.  */
  7162   DEFSYM (QCcolor, ":color");
  7163   DEFSYM (QCline_width, ":line-width");
  7164   DEFSYM (QCstyle, ":style");
  7165   DEFSYM (QCposition, ":position");
  7166   DEFSYM (Qline, "line");
  7167   DEFSYM (Qwave, "wave");
  7168   DEFSYM (Qreleased_button, "released-button");
  7169   DEFSYM (Qpressed_button, "pressed-button");
  7170   DEFSYM (Qflat_button, "flat-button");
  7171   DEFSYM (Qnormal, "normal");
  7172   DEFSYM (Qthin, "thin");
  7173   DEFSYM (Qextra_light, "extra-light");
  7174   DEFSYM (Qultra_light, "ultra-light");
  7175   DEFSYM (Qlight, "light");
  7176   DEFSYM (Qsemi_light, "semi-light");
  7177   DEFSYM (Qmedium, "medium");
  7178   DEFSYM (Qsemi_bold, "semi-bold");
  7179   DEFSYM (Qbook, "book");
  7180   DEFSYM (Qbold, "bold");
  7181   DEFSYM (Qextra_bold, "extra-bold");
  7182   DEFSYM (Qultra_bold, "ultra-bold");
  7183   DEFSYM (Qheavy, "heavy");
  7184   DEFSYM (Qultra_heavy, "ultra-heavy");
  7185   DEFSYM (Qblack, "black");
  7186   DEFSYM (Qoblique, "oblique");
  7187   DEFSYM (Qitalic, "italic");
  7188   DEFSYM (Qreset, "reset");
  7189 
  7190   /* The symbols `foreground-color' and `background-color' which can be
  7191      used as part of a `face' property.  This is for compatibility with
  7192      Emacs 20.2.  */
  7193   DEFSYM (Qbackground_color, "background-color");
  7194   DEFSYM (Qforeground_color, "foreground-color");
  7195 
  7196   DEFSYM (Qunspecified, "unspecified");
  7197   DEFSYM (QCignore_defface, ":ignore-defface");
  7198 
  7199   /* Used for limiting character attributes to windows with specific
  7200      characteristics.  */
  7201   DEFSYM (QCwindow, ":window");
  7202   DEFSYM (QCfiltered, ":filtered");
  7203 
  7204   /* The symbol `face-alias'.  A symbol having that property is an
  7205      alias for another face.  Value of the property is the name of
  7206      the aliased face.  */
  7207   DEFSYM (Qface_alias, "face-alias");
  7208 
  7209   /* Names of basic faces.  */
  7210   DEFSYM (Qdefault, "default");
  7211   DEFSYM (Qtool_bar, "tool-bar");
  7212   DEFSYM (Qtab_bar, "tab-bar");
  7213   DEFSYM (Qfringe, "fringe");
  7214   DEFSYM (Qtab_line, "tab-line");
  7215   DEFSYM (Qheader_line, "header-line");
  7216   DEFSYM (Qscroll_bar, "scroll-bar");
  7217   DEFSYM (Qmenu, "menu");
  7218   DEFSYM (Qcursor, "cursor");
  7219   DEFSYM (Qborder, "border");
  7220   DEFSYM (Qmouse, "mouse");
  7221   DEFSYM (Qmode_line_inactive, "mode-line-inactive");
  7222   DEFSYM (Qmode_line_active, "mode-line-active");
  7223   DEFSYM (Qvertical_border, "vertical-border");
  7224   DEFSYM (Qwindow_divider, "window-divider");
  7225   DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel");
  7226   DEFSYM (Qwindow_divider_last_pixel, "window-divider-last-pixel");
  7227   DEFSYM (Qinternal_border, "internal-border");
  7228   DEFSYM (Qchild_frame_border, "child-frame-border");
  7229 
  7230   /* TTY color-related functions (defined in tty-colors.el).  */
  7231   DEFSYM (Qtty_color_desc, "tty-color-desc");
  7232   DEFSYM (Qtty_color_standard_values, "tty-color-standard-values");
  7233   DEFSYM (Qtty_color_by_index, "tty-color-by-index");
  7234 
  7235   /* The name of the function used to compute colors on TTYs.  */
  7236   DEFSYM (Qtty_color_alist, "tty-color-alist");
  7237 
  7238   Vface_alternative_font_family_alist = Qnil;
  7239   staticpro (&Vface_alternative_font_family_alist);
  7240   Vface_alternative_font_registry_alist = Qnil;
  7241   staticpro (&Vface_alternative_font_registry_alist);
  7242 
  7243   defsubr (&Sinternal_make_lisp_face);
  7244   defsubr (&Sinternal_lisp_face_p);
  7245   defsubr (&Sinternal_set_lisp_face_attribute);
  7246 #ifdef HAVE_WINDOW_SYSTEM
  7247   defsubr (&Sinternal_set_lisp_face_attribute_from_resource);
  7248 #endif
  7249   defsubr (&Scolor_gray_p);
  7250   defsubr (&Scolor_supported_p);
  7251 #ifndef HAVE_X_WINDOWS
  7252   defsubr (&Sx_load_color_file);
  7253 #endif
  7254   defsubr (&Sface_attribute_relative_p);
  7255   defsubr (&Smerge_face_attribute);
  7256   defsubr (&Sinternal_get_lisp_face_attribute);
  7257   defsubr (&Sinternal_lisp_face_attribute_values);
  7258   defsubr (&Sinternal_lisp_face_equal_p);
  7259   defsubr (&Sinternal_lisp_face_empty_p);
  7260   defsubr (&Sinternal_copy_lisp_face);
  7261   defsubr (&Sinternal_merge_in_global_face);
  7262   defsubr (&Sface_font);
  7263   defsubr (&Sframe_face_hash_table);
  7264   defsubr (&Sdisplay_supports_face_attributes_p);
  7265   defsubr (&Scolor_distance);
  7266   defsubr (&Sinternal_set_font_selection_order);
  7267   defsubr (&Sinternal_set_alternative_font_family_alist);
  7268   defsubr (&Sinternal_set_alternative_font_registry_alist);
  7269   defsubr (&Sface_attributes_as_vector);
  7270 #ifdef GLYPH_DEBUG
  7271   defsubr (&Sdump_face);
  7272   defsubr (&Sshow_face_resources);
  7273 #endif /* GLYPH_DEBUG */
  7274   defsubr (&Sclear_face_cache);
  7275   defsubr (&Stty_suppress_bold_inverse_default_colors);
  7276 
  7277 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
  7278   defsubr (&Sdump_colors);
  7279 #endif
  7280 
  7281   DEFVAR_BOOL ("face-filters-always-match", face_filters_always_match,
  7282     doc: /* Non-nil means that face filters are always deemed to match.
  7283 This variable is intended for use only by code that evaluates
  7284 the "specificity" of a face specification and should be let-bound
  7285 only for this purpose.  */);
  7286 
  7287   DEFVAR_LISP ("face--new-frame-defaults", Vface_new_frame_defaults,
  7288     doc: /* Hash table of global face definitions (for internal use only.)  */);
  7289   Vface_new_frame_defaults =
  7290     /* 33 entries is enough to fit all basic faces */
  7291     make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE,
  7292                      DEFAULT_REHASH_THRESHOLD, Qnil, false);
  7293 
  7294   DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
  7295     doc: /* Default stipple pattern used on monochrome displays.
  7296 This stipple pattern is used on monochrome displays
  7297 instead of shades of gray for a face background color.
  7298 See `set-face-stipple' for possible values for this variable.  */);
  7299   Vface_default_stipple = build_pure_c_string ("gray3");
  7300 
  7301   DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist,
  7302    doc: /* An alist of defined terminal colors and their RGB values.
  7303 See the docstring of `tty-color-alist' for the details.  */);
  7304   Vtty_defined_color_alist = Qnil;
  7305 
  7306   DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed,
  7307                doc: /* Allowed scalable fonts.
  7308 A value of nil means don't allow any scalable fonts.
  7309 A value of t means allow any scalable font.
  7310 Otherwise, value must be a list of regular expressions.  A font may be
  7311 scaled if its name matches a regular expression in the list.
  7312 Note that if value is nil, a scalable font might still be used, if no
  7313 other font of the appropriate family and registry is available.  */);
  7314   Vscalable_fonts_allowed = Qnil;
  7315 
  7316   DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts,
  7317                doc: /* List of ignored fonts.
  7318 Each element is a regular expression that matches names of fonts to
  7319 ignore.  */);
  7320 #ifdef HAVE_XFT
  7321   /* This font causes libXft crashes, so ignore it by default.  Bug#37786.  */
  7322   Vface_ignored_fonts = list1 (build_string ("Noto Color Emoji"));
  7323 #else
  7324   Vface_ignored_fonts = Qnil;
  7325 #endif
  7326 #ifdef HAVE_OTF_KANNADA_BUG
  7327   /* This font causes libotf crashes, so ignore it when we know we're
  7328      using a vulnerable version.  https://debbugs.gnu.org/30193  */
  7329   Vface_ignored_fonts = Fcons (build_string ("Noto Serif Kannada"), Vface_ignored_fonts);
  7330 #endif
  7331 
  7332   DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist,
  7333                doc: /* Alist of face remappings.
  7334 Each element is of the form:
  7335 
  7336    (FACE . REPLACEMENT),
  7337 
  7338 which causes display of the face FACE to use REPLACEMENT instead.
  7339 REPLACEMENT is a face specification, i.e. one of the following:
  7340 
  7341   (1) a face name
  7342   (2) a property list of attribute/value pairs, or
  7343   (3) a list in which each element has one of the above forms.
  7344 
  7345 List values for REPLACEMENT are merged to form the final face
  7346 specification, with earlier entries taking precedence, in the same way
  7347 as with the `face' text property.
  7348 
  7349 Face-name remapping cycles are suppressed; recursive references use
  7350 the underlying face instead of the remapped face.  So a remapping of
  7351 the form:
  7352 
  7353    (FACE EXTRA-FACE... FACE)
  7354 
  7355 or:
  7356 
  7357    (FACE (FACE-ATTR VAL ...) FACE)
  7358 
  7359 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
  7360 existing definition of FACE.  Note that this isn't necessary for the
  7361 default face, since every face inherits from the default face.
  7362 
  7363 An entry in the list can also be a filtered face expression of the
  7364 form:
  7365 
  7366   (:filtered FILTER FACE-SPECIFICATION)
  7367 
  7368 This construct applies FACE-SPECIFICATION (which can have any of the
  7369 forms allowed for face specifications generally) only if FILTER
  7370 matches at the moment Emacs wants to draw text with the combined face.
  7371 
  7372 The only filters currently defined are NIL (which always matches) and
  7373 (:window PARAMETER VALUE), which matches only in the context of a
  7374 window with a parameter EQ-equal to VALUE.
  7375 
  7376 An entry in the face list can also be nil, which does nothing.
  7377 
  7378 If `face-remapping-alist' is made buffer-local, the face remapping
  7379 takes effect only in that buffer.  For instance, the mode my-mode
  7380 could define a face `my-mode-default', and then in the mode setup
  7381 function, do:
  7382 
  7383    (set (make-local-variable \\='face-remapping-alist)
  7384         (copy-tree \\='((default my-mode-default)))).
  7385 
  7386 You probably want to use the face-remap package included in Emacs
  7387 instead of manipulating face-remapping-alist directly.  Note that many
  7388 of the functions in that package modify the list destructively, so make
  7389 sure you set it to a fresh value (for instance, use `copy-tree' as in
  7390 the example above) before modifying.
  7391 
  7392 Because Emacs normally only redraws screen areas when the underlying
  7393 buffer contents change, you may need to call `redraw-display' after
  7394 changing this variable for it to take effect.  */);
  7395   Vface_remapping_alist = Qnil;
  7396   DEFSYM (Qface_remapping_alist,"face-remapping-alist");
  7397 
  7398   DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist,
  7399                doc: /* Alist of fonts vs the rescaling factors.
  7400 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
  7401 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
  7402 RESCALE-RATIO is a floating point number to specify how much larger
  7403 \(or smaller) font we should use.  For instance, if a face requests
  7404 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point.  */);
  7405   Vface_font_rescale_alist = Qnil;
  7406 
  7407   DEFVAR_INT ("face-near-same-color-threshold", face_near_same_color_threshold,
  7408               doc: /* Threshold for using distant-foreground color instead of foreground.
  7409 
  7410 The value should be an integer number providing the minimum distance
  7411 between two colors that will still qualify them to be used as foreground
  7412 and background.  If the value of `color-distance', invoked with a nil
  7413 METRIC argument, for the foreground and background colors of a face is
  7414 less than this threshold, the distant-foreground color, if defined,
  7415 will be used for the face instead of the foreground color.
  7416 
  7417 Lisp programs that change the value of this variable should also
  7418 clear the face cache, see `clear-face-cache'.  */);
  7419   face_near_same_color_threshold = 30000;
  7420 
  7421   DEFVAR_LISP ("face-font-lax-matched-attributes",
  7422                Vface_font_lax_matched_attributes,
  7423                doc: /* Whether to match some face attributes in lax manner when realizing faces.
  7424 
  7425 If non-nil, some font-related face attributes will be matched in a lax
  7426 manner when looking for candidate fonts.
  7427 If the value is t, the default, the search for fonts will not insist
  7428 on exact match for 3 font attributes: weight, width, and slant.
  7429 Instead, it will examine the available fonts with various values of
  7430 these attributes, and select the font that is the closest possible
  7431 match.  (If an exact match is available, it will still be selected,
  7432 as that is the closest match.)  For example, looking for a semi-bold
  7433 font might select a bold or a medium-weight font if no semi-bold font
  7434 matching other attributes can be found.  This is especially important
  7435 when the `default' face specifies unusual values for one or more of
  7436 these 3 attributes, which other installed fonts don't support.
  7437 
  7438 The value can also be a list of font-related face attribute symbols;
  7439 see `set-face-attribute' for the full list of attributes.  Then the
  7440 corresponding face attributes will be treated as "soft" constraints
  7441 in the manner described above, instead of the default 3 attributes.
  7442 
  7443 If the value is nil, candidate fonts might be rejected if the don't
  7444 have exactly the same values of attributes as the face requests.
  7445 
  7446 This variable exists for debugging of the font-selection process,
  7447 and we advise not to change it otherwise.  */);
  7448   Vface_font_lax_matched_attributes = Qt;
  7449 
  7450 #ifdef HAVE_WINDOW_SYSTEM
  7451   defsubr (&Sbitmap_spec_p);
  7452   defsubr (&Sx_list_fonts);
  7453   defsubr (&Sinternal_face_x_get_resource);
  7454   defsubr (&Sx_family_fonts);
  7455 #endif
  7456   defsubr (&Scolor_values_from_color_spec);
  7457 }
/* [<][>][^][v][top][bottom][index][help] */
root/src/xfaces.c

DEFINITIONS
