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

DEFINITIONS
