xfaces.c 217 KB
Newer Older
Gerd Moellmann's avatar
Gerd Moellmann committed
1
/* xfaces.c -- "Face" primitives.
Glenn Morris's avatar
Glenn Morris committed
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1993-1994, 1998-2020 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4

Jim Blandy's avatar
Jim Blandy committed
5 6
This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

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/>.  */
Jim Blandy's avatar
Jim Blandy committed
19

Gerd Moellmann's avatar
Gerd Moellmann committed
20 21 22 23 24 25 26 27
/* New face implementation by Gerd Moellmann <gerd@gnu.org>.  */

/* Faces.

   When using Emacs with X, the display style of characters can be
   changed by defining `faces'.  Each face can specify the following
   display attributes:

28
   1. Font family name.
29

Juanma Barranquero's avatar
Juanma Barranquero committed
30
   2. Font foundry name.
Kenichi Handa's avatar
Kenichi Handa committed
31 32

   3. Relative proportionate width, aka character set width or set
Gerd Moellmann's avatar
Gerd Moellmann committed
33
   width (swidth), e.g. `semi-compressed'.
34

Kenichi Handa's avatar
Kenichi Handa committed
35
   4. Font height in 1/10pt.
36

Kenichi Handa's avatar
Kenichi Handa committed
37
   5. Font weight, e.g. `bold'.
38

Kenichi Handa's avatar
Kenichi Handa committed
39
   6. Font slant, e.g. `italic'.
40

Kenichi Handa's avatar
Kenichi Handa committed
41
   7. Foreground color.
42

Kenichi Handa's avatar
Kenichi Handa committed
43
   8. Background color.
Gerd Moellmann's avatar
Gerd Moellmann committed
44

Kenichi Handa's avatar
Kenichi Handa committed
45
   9. Whether or not characters should be underlined, and in what color.
Gerd Moellmann's avatar
Gerd Moellmann committed
46

Kenichi Handa's avatar
Kenichi Handa committed
47
   10. Whether or not characters should be displayed in inverse video.
Gerd Moellmann's avatar
Gerd Moellmann committed
48

Kenichi Handa's avatar
Kenichi Handa committed
49
   11. A background stipple, a bitmap.
Gerd Moellmann's avatar
Gerd Moellmann committed
50

Kenichi Handa's avatar
Kenichi Handa committed
51
   12. Whether or not characters should be overlined, and in what color.
Gerd Moellmann's avatar
Gerd Moellmann committed
52

Kenichi Handa's avatar
Kenichi Handa committed
53
   13. Whether or not characters should be strike-through, and in what
Gerd Moellmann's avatar
Gerd Moellmann committed
54 55
   color.

Kenichi Handa's avatar
Kenichi Handa committed
56
   14. Whether or not a box should be drawn around characters, the box
Gerd Moellmann's avatar
Gerd Moellmann committed
57 58
   type, and, for simple boxes, in what color.

Kenichi Handa's avatar
Kenichi Handa committed
59
   15. Font-spec, or nil.  This is a special attribute.
60 61 62 63 64 65 66 67

   A font-spec is a collection of font attributes (specs).

   When this attribute is specified, the face uses a font matching
   with the specs as is except for what overwritten by the specs in
   the fontset (see below).  In addition, the other font-related
   attributes (1st thru 5th) are updated from the spec.

68
   On the other hand, if one of the other font-related attributes are
Paul Eggert's avatar
Paul Eggert committed
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 74 75 76 77
   17. A fontset name.  This is another special attribute.

   A fontset is a mappings from characters to font-specs, and the
   specs overwrite the font-spec in the 14th attribute.

78 79 80 81 82 83 84 85 86 87 88 89
   18. A "distant background" color, to be used when the foreground is
   too close to the background and is hard to read.

   19. Whether to extend the face to end of line when the face
   "covers" the newline that ends the line.

   On the C level, a Lisp face is completely represented by its array
   of attributes.  In that array, the zeroth element is Qface, and the
   rest are the 19 face attributes described above.  The
   lface_attribute_index enumeration, defined on dispextern.h, with
   values given by the LFACE_*_INDEX constants, is used to reference
   the individual attributes.
Kenichi Handa's avatar
Kenichi Handa committed
90

91
   Faces are frame-local by nature because Emacs allows you to define the
Gerd Moellmann's avatar
Gerd Moellmann committed
92 93 94
   same named face (face names are symbols) differently for different
   frames.  Each frame has an alist of face definitions for all named
   faces.  The value of a named face in such an alist is a Lisp vector
95 96
   with the symbol `face' in slot 0, and a slot for each of the face
   attributes mentioned above.
Gerd Moellmann's avatar
Gerd Moellmann committed
97 98 99 100

   There is also a global face alist `Vface_new_frame_defaults'.  Face
   definitions from this list are used to initialize faces of newly
   created frames.
101

Gerd Moellmann's avatar
Gerd Moellmann committed
102
   A face doesn't have to specify all attributes.  Those not specified
103 104
   have a value of `unspecified'.  Faces specifying all attributes but
   the 14th are called `fully-specified'.
Gerd Moellmann's avatar
Gerd Moellmann committed
105 106 107 108 109 110


   Face merging.

   The display style of a given character in the text is determined by
   combining several faces.  This process is called `face merging'.
111 112 113 114 115 116 117 118 119 120 121 122
   Face merging combines the attributes of each of the faces being
   merged such that the attributes of the face that is merged later
   override those of a face merged earlier in the process.  In
   particular, this replaces any 'unspecified' attributes with
   non-'unspecified' values.  Also, if a face inherits from another
   (via the :inherit attribute), the attributes of the parent face,
   recursively, are applied where the inheriting face doesn't specify
   non-'unspecified' values.  Any aspect of the display style that
   isn't specified by overlays or text properties is taken from the
   'default' face.  Since it is made sure that the default face is
   always fully-specified, face merging always results in a
   fully-specified face.
Gerd Moellmann's avatar
Gerd Moellmann committed
123 124 125


   Face realization.
126

Gerd Moellmann's avatar
Gerd Moellmann committed
127 128 129 130
   After all face attributes for a character have been determined by
   merging faces of that character, that face is `realized'.  The
   realization process maps face attributes to what is physically
   available on the system where Emacs runs.  The result is a
Paul Eggert's avatar
Paul Eggert committed
131
   `realized face' in the form of a struct face which is stored in the
Gerd Moellmann's avatar
Gerd Moellmann committed
132 133
   face cache of the frame on which it was realized.

134 135 136 137
   Face realization is done in the context of the character to display
   because different fonts may be used for different characters.  In
   other words, for characters that have different font
   specifications, different realized faces are needed to display
Gerd Moellmann's avatar
Gerd Moellmann committed
138 139
   them.

140 141 142 143 144 145 146 147 148 149
   Font specification is done by fontsets.  See the comment in
   fontset.c for the details.  In the current implementation, all ASCII
   characters share the same font in a fontset.

   Faces are at first realized for ASCII characters, and, at that
   time, assigned a specific realized fontset.  Hereafter, we call
   such a face as `ASCII face'.  When a face for a multibyte character
   is realized, it inherits (thus shares) a fontset of an ASCII face
   that has the same attributes other than font-related ones.

Kenichi Handa's avatar
Kenichi Handa committed
150
   Thus, all realized faces have a realized fontset.
Gerd Moellmann's avatar
Gerd Moellmann committed
151 152 153 154


   Unibyte text.

155 156 157 158 159
   Unibyte text (i.e. raw 8-bit characters) is displayed with the same
   font as ASCII characters.  That is because it is expected that
   unibyte text users specify a font that is suitable both for ASCII
   and raw 8-bit characters.

Gerd Moellmann's avatar
Gerd Moellmann committed
160 161 162 163

   Font selection.

   Font selection tries to find the best available matching font for a
164
   given (character, face) combination.
Gerd Moellmann's avatar
Gerd Moellmann committed
165

166 167 168 169 170 171
   If the face specifies a fontset name, that fontset determines a
   pattern for fonts of the given character.  If the face specifies a
   font name or the other font-related attributes, a fontset is
   realized from the default fontset.  In that case, that
   specification determines a pattern for ASCII characters and the
   default fontset determines a pattern for multibyte characters.
Gerd Moellmann's avatar
Gerd Moellmann committed
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187

   Available fonts on the system on which Emacs runs are then matched
   against the font pattern.  The result of font selection is the best
   match for the given face attributes in this font list.

   Font selection can be influenced by the user.

   1. The user can specify the relative importance he gives the face
   attributes width, height, weight, and slant by setting
   face-font-selection-order (faces.el) to a list of face attribute
   names.  The default is '(:width :height :weight :slant), and means
   that font selection first tries to find a good match for the font
   width specified by a face, then---within fonts with that
   width---tries to find a best match for the specified font height,
   etc.

188
   2. Setting face-font-family-alternatives allows the user to
Gerd Moellmann's avatar
Gerd Moellmann committed
189 190 191
   specify alternative font families to try if a family specified by a
   face doesn't exist.

192 193 194 195 196 197 198
   3. Setting face-font-registry-alternatives allows the user to
   specify all alternative font registries to try for a face
   specifying a registry.

   4. Setting face-ignored-fonts allows the user to ignore specific
   fonts.

Gerd Moellmann's avatar
Gerd Moellmann committed
199

Stefan Monnier's avatar
Typos.  
Stefan Monnier committed
200
   Character composition.
201 202 203 204 205 206 207 208

   Usually, the realization process is already finished when Emacs
   actually reflects the desired glyph matrix on the screen.  However,
   on displaying a composition (sequence of characters to be composed
   on the screen), a suitable font for the components of the
   composition is selected and realized while drawing them on the
   screen, i.e.  the realization process is delayed but in principle
   the same.
Gerd Moellmann's avatar
Gerd Moellmann committed
209

210

Gerd Moellmann's avatar
Gerd Moellmann committed
211 212 213 214 215 216 217
   Initialization of basic faces.

   The faces `default', `modeline' are considered `basic faces'.
   When redisplay happens the first time for a newly created frame,
   basic faces are realized for CHARSET_ASCII.  Frame parameters are
   used to fill in unspecified attributes of the default face.  */

218
#include <config.h>
Paul Eggert's avatar
Paul Eggert committed
219
#include <stdlib.h>
220
#include "sysstdio.h"
Jim Blandy's avatar
Jim Blandy committed
221 222
#include <sys/types.h>
#include <sys/stat.h>
223
#include <math.h>
224

Jim Blandy's avatar
Jim Blandy committed
225
#include "lisp.h"
226
#include "character.h"
227 228
#include "frame.h"

229 230 231 232
#ifdef USE_MOTIF
#include <Xm/Xm.h>
#include <Xm/XmStrDefs.h>
#endif /* USE_MOTIF */
Gerd Moellmann's avatar
Gerd Moellmann committed
233

Morten Welinder's avatar
Morten Welinder committed
234 235 236
#ifdef MSDOS
#include "dosfns.h"
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
237

238 239
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
240
#include "fontset.h"
Daniel Colascione's avatar
Daniel Colascione committed
241
#ifdef HAVE_NTGUI
242
#define GCGraphicsExposures 0
Daniel Colascione's avatar
Daniel Colascione committed
243
#endif /* HAVE_NTGUI */
244

245 246 247
#ifdef HAVE_NS
#define GCGraphicsExposures 0
#endif /* HAVE_NS */
248
#endif /* HAVE_WINDOW_SYSTEM */
249

Jim Blandy's avatar
Jim Blandy committed
250
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
251
#include "dispextern.h"
Jim Blandy's avatar
Jim Blandy committed
252
#include "blockinput.h"
253
#include "window.h"
254
#include "termchar.h"
Jim Blandy's avatar
Jim Blandy committed
255

Kenichi Handa's avatar
Kenichi Handa committed
256 257
#include "font.h"

Morten Welinder's avatar
Morten Welinder committed
258
#ifdef HAVE_X_WINDOWS
Gerd Moellmann's avatar
Gerd Moellmann committed
259 260

/* Compensate for a bug in Xos.h on some systems, on which it requires
261 262 263 264
   time.h.  On some such systems, Xos.h tries to redefine struct
   timeval and struct timezone if USG is #defined while it is
   #included.  */

Gerd Moellmann's avatar
Gerd Moellmann committed
265
#ifdef XOS_NEEDS_TIME_H
266
#include <time.h>
267 268 269
#undef USG
#include <X11/Xos.h>
#define USG
270
#define __TIMEVAL__
271 272
#if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros.  */
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
273 274 275
#else /* not XOS_NEEDS_TIME_H */
#include <X11/Xos.h>
#endif /* not XOS_NEEDS_TIME_H */
276

Gerd Moellmann's avatar
Gerd Moellmann committed
277
#endif /* HAVE_X_WINDOWS */
278

279
#include <c-ctype.h>
Jim Blandy's avatar
Jim Blandy committed
280

Paul Eggert's avatar
Paul Eggert committed
281
/* True if face attribute ATTR is unspecified.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
282 283 284

#define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)

Paul Eggert's avatar
Paul Eggert committed
285
/* True if face attribute ATTR is `ignore-defface'.  */
286

287
#define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
288

289
/* Size of hash table of realized faces in face caches (should be a
Gerd Moellmann's avatar
Gerd Moellmann committed
290 291 292 293
   prime number).  */

#define FACE_CACHE_BUCKETS_SIZE 1001

294
char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
Gerd Moellmann's avatar
Gerd Moellmann committed
295 296 297 298 299 300 301

/* Alist of alternative font families.  Each element is of the form
   (FAMILY FAMILY1 FAMILY2 ...).  If fonts of FAMILY can't be loaded,
   try FAMILY1, then FAMILY2, ...  */

Lisp_Object Vface_alternative_font_family_alist;

302 303 304 305 306 307
/* Alist of alternative font registries.  Each element is of the form
   (REGISTRY REGISTRY1 REGISTRY2...).  If fonts of REGISTRY can't be
   loaded, try REGISTRY1, then REGISTRY2, ...  */

Lisp_Object Vface_alternative_font_registry_alist;

Gerd Moellmann's avatar
Gerd Moellmann committed
308
/* The next ID to assign to Lisp faces.  */
309

Gerd Moellmann's avatar
Gerd Moellmann committed
310
static int next_lface_id;
Jim Blandy's avatar
Jim Blandy committed
311

Gerd Moellmann's avatar
Gerd Moellmann committed
312
/* A vector mapping Lisp face Id's to face names.  */
Jim Blandy's avatar
Jim Blandy committed
313

Gerd Moellmann's avatar
Gerd Moellmann committed
314
static Lisp_Object *lface_id_to_name;
315
static ptrdiff_t lface_id_to_name_size;
Jim Blandy's avatar
Jim Blandy committed
316

317 318
#ifdef HAVE_WINDOW_SYSTEM

Gerd Moellmann's avatar
Gerd Moellmann committed
319 320 321 322 323 324 325 326
/* Counter for calls to clear_face_cache.  If this counter reaches
   CLEAR_FONT_TABLE_COUNT, and a frame has more than
   CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed.  */

static int clear_font_table_count;
#define CLEAR_FONT_TABLE_COUNT	100
#define CLEAR_FONT_TABLE_NFONTS	10

327 328
#endif /* HAVE_WINDOW_SYSTEM */

329
/* True means face attributes have been changed since the last
Gerd Moellmann's avatar
Gerd Moellmann committed
330 331
   redisplay.  Used in redisplay_internal.  */

332
bool face_change;
Gerd Moellmann's avatar
Gerd Moellmann committed
333

Paul Eggert's avatar
Paul Eggert committed
334
/* True means don't display bold text if a face's foreground
335 336 337 338
   and background colors are the inverse of the default colors of the
   display.   This is a kluge to suppress `bold black' foreground text
   which is hard to read on an LCD monitor.  */

Paul Eggert's avatar
Paul Eggert committed
339
static bool tty_suppress_bold_inverse_default_colors_p;
340

Gerd Moellmann's avatar
Gerd Moellmann committed
341 342
/* The total number of colors currently allocated.  */

343
#ifdef GLYPH_DEBUG
Gerd Moellmann's avatar
Gerd Moellmann committed
344 345 346 347 348
static int ncolors_allocated;
static int npixmaps_allocated;
static int ngcs;
#endif

Paul Eggert's avatar
Paul Eggert committed
349
/* True means the definition of the `menu' face for new frames has
350 351
   been changed.  */

Paul Eggert's avatar
Paul Eggert committed
352
static bool menu_face_changed_default;
Gerd Moellmann's avatar
Gerd Moellmann committed
353

354
struct named_merge_point;
Gerd Moellmann's avatar
Gerd Moellmann committed
355

356
static struct face *realize_face (struct face_cache *, Lisp_Object *,
Andreas Schwab's avatar
Andreas Schwab committed
357
				  int);
358
static struct face *realize_gui_face (struct face_cache *, Lisp_Object *);
359
static struct face *realize_tty_face (struct face_cache *, Lisp_Object *);
360 361
static bool realize_basic_faces (struct frame *);
static bool realize_default_face (struct frame *);
362 363 364
static void realize_named_face (struct frame *, Lisp_Object, int);
static struct face_cache *make_face_cache (struct frame *);
static void free_face_cache (struct face_cache *);
365 366
static bool merge_face_ref (struct window *w,
                            struct frame *, Lisp_Object, Lisp_Object *,
367 368
                            bool, struct named_merge_point *,
                            enum lface_attribute_index);
369
static int color_distance (Emacs_Color *x, Emacs_Color *y);
Jim Blandy's avatar
Jim Blandy committed
370

371 372 373 374 375 376 377
#ifdef HAVE_WINDOW_SYSTEM
static void set_font_frame_param (Lisp_Object, Lisp_Object);
static void clear_face_gcs (struct face_cache *);
static struct face *realize_non_ascii_face (struct frame *, Lisp_Object,
					    struct face *);
#endif /* HAVE_WINDOW_SYSTEM */

Gerd Moellmann's avatar
Gerd Moellmann committed
378 379 380
/***********************************************************************
			      Utilities
 ***********************************************************************/
Jim Blandy's avatar
Jim Blandy committed
381

Morten Welinder's avatar
Morten Welinder committed
382
#ifdef HAVE_X_WINDOWS
383

384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401
#ifdef DEBUG_X_COLORS

/* The following is a poor mans infrastructure for debugging X color
   allocation problems on displays with PseudoColor-8.  Some X servers
   like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
   color reference counts completely so that they don't signal an
   error when a color is freed whose reference count is already 0.
   Other X servers do.  To help me debug this, the following code
   implements a simple reference counting schema of its own, for a
   single display/screen.  --gerd.  */

/* Reference counts for pixel colors.  */

int color_count[256];

/* Register color PIXEL as allocated.  */

void
Andreas Schwab's avatar
Andreas Schwab committed
402
register_color (unsigned long pixel)
403
{
404
  eassert (pixel < 256);
405 406 407 408 409 410 411
  ++color_count[pixel];
}


/* Register color PIXEL as deallocated.  */

void
Andreas Schwab's avatar
Andreas Schwab committed
412
unregister_color (unsigned long pixel)
413
{
414
  eassert (pixel < 256);
415 416 417
  if (color_count[pixel] > 0)
    --color_count[pixel];
  else
418
    emacs_abort ();
419 420 421 422 423 424
}


/* Register N colors from PIXELS as deallocated.  */

void
Andreas Schwab's avatar
Andreas Schwab committed
425
unregister_colors (unsigned long *pixels, int n)
426 427 428 429 430 431
{
  int i;
  for (i = 0; i < n; ++i)
    unregister_color (pixels[i]);
}

432

Paul Eggert's avatar
Paul Eggert committed
433
DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
434
       doc: /* Dump currently allocated colors to stderr.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
435
  (void)
436 437 438
{
  int i, n;

439
  putc ('\n', stderr);
440

441
  for (i = n = 0; i < ARRAYELTS (color_count); ++i)
442 443 444 445
    if (color_count[i])
      {
	fprintf (stderr, "%3d: %5d", i, color_count[i]);
	++n;
446
	putc (n % 5 == 0 ? '\n' : '\t', stderr);
447 448 449
      }

  if (n % 5 != 0)
450
    putc ('\n', stderr);
451 452 453
  return Qnil;
}

454 455
#endif /* DEBUG_X_COLORS */

456

457 458 459 460 461
/* Free colors used on frame F.  PIXELS is an array of NPIXELS pixel
   color values.  Interrupt input must be blocked when this function
   is called.  */

void
462
x_free_colors (struct frame *f, unsigned long *pixels, int npixels)
463 464 465
{
  /* If display has an immutable color map, freeing colors is not
     necessary and some servers don't allow it.  So don't do it.  */
466
  if (x_mutable_colormap (FRAME_X_VISUAL (f)))
467
    {
468
#ifdef DEBUG_X_COLORS
469
      unregister_colors (pixels, npixels);
470
#endif
471 472
      XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
		   pixels, npixels, 0);
473 474 475 476
    }
}


477 478
#ifdef USE_X_TOOLKIT

479
/* Free colors used on display DPY.  PIXELS is an array of NPIXELS pixel
480 481 482 483
   color values.  Interrupt input must be blocked when this function
   is called.  */

void
Andreas Schwab's avatar
Andreas Schwab committed
484
x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap,
485
		   unsigned long *pixels, int npixels)
486 487 488 489 490
{
  struct x_display_info *dpyinfo = x_display_info_for_display (dpy);

  /* If display has an immutable color map, freeing colors is not
     necessary and some servers don't allow it.  So don't do it.  */
491
  if (x_mutable_colormap (dpyinfo->visual))
492
    {
493
#ifdef DEBUG_X_COLORS
494
      unregister_colors (pixels, npixels);
495
#endif
496
      XFreeColors (dpy, cmap, pixels, npixels, 0);
497 498
    }
}
499
#endif /* USE_X_TOOLKIT */
500

Gerd Moellmann's avatar
Gerd Moellmann committed
501 502 503
/* Create and return a GC for use on frame F.  GC values and mask
   are given by XGCV and MASK.  */

504
static GC
505
x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
Jim Blandy's avatar
Jim Blandy committed
506 507
{
  GC gc;
508
  block_input ();
509
  gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), mask, xgcv);
510
  unblock_input ();
Gerd Moellmann's avatar
Gerd Moellmann committed
511 512 513
  IF_DEBUG (++ngcs);
  return gc;
}
Jim Blandy's avatar
Jim Blandy committed
514

515

Gerd Moellmann's avatar
Gerd Moellmann committed
516 517
/* Free GC which was used on frame F.  */

518
static void
519
x_free_gc (struct frame *f, GC gc)
Gerd Moellmann's avatar
Gerd Moellmann committed
520
{
521
  eassert (input_blocked_p ());
522
  IF_DEBUG ((--ngcs, eassert (ngcs >= 0)));
Gerd Moellmann's avatar
Gerd Moellmann committed
523 524
  XFreeGC (FRAME_X_DISPLAY (f), gc);
}
525

Gerd Moellmann's avatar
Gerd Moellmann committed
526
#endif /* HAVE_X_WINDOWS */
527

Daniel Colascione's avatar
Daniel Colascione committed
528
#ifdef HAVE_NTGUI
529 530
/* W32 emulation of GCs */

531 532
static Emacs_GC *
x_create_gc (struct frame *f, unsigned long mask, Emacs_GC *egc)
533
{
534
  Emacs_GC *gc;
535
  block_input ();
536
  gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, egc);
537
  unblock_input ();
538 539 540 541 542 543 544
  IF_DEBUG (++ngcs);
  return gc;
}


/* Free GC which was used on frame F.  */

545
static void
546
x_free_gc (struct frame *f, Emacs_GC *gc)
547
{
548
  IF_DEBUG ((--ngcs, eassert (ngcs >= 0)));
549 550 551
  xfree (gc);
}

Daniel Colascione's avatar
Daniel Colascione committed
552
#endif  /* HAVE_NTGUI */
553

554 555 556
#ifdef HAVE_NS
/* NS emulation of GCs */

557
static Emacs_GC *
558
x_create_gc (struct frame *f,
Andreas Schwab's avatar
Andreas Schwab committed
559
	     unsigned long mask,
560
	     Emacs_GC *egc)
561
{
562 563
  Emacs_GC *gc = xmalloc (sizeof *gc);
  *gc = *egc;
564 565 566
  return gc;
}

567
static void
568
x_free_gc (struct frame *f, Emacs_GC *gc)
569
{
570
  xfree (gc);
571 572 573
}
#endif  /* HAVE_NS */

Gerd Moellmann's avatar
Gerd Moellmann committed
574 575 576
/***********************************************************************
			   Frames and faces
 ***********************************************************************/
577

Gerd Moellmann's avatar
Gerd Moellmann committed
578
/* Initialize face cache and basic faces for frame F.  */
579

Gerd Moellmann's avatar
Gerd Moellmann committed
580
void
581
init_frame_faces (struct frame *f)
582
{
Gerd Moellmann's avatar
Gerd Moellmann committed
583 584 585
  /* Make a face cache, if F doesn't have one.  */
  if (FRAME_FACE_CACHE (f) == NULL)
    FRAME_FACE_CACHE (f) = make_face_cache (f);
586

587
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
588
  /* Make the image cache.  */
589
  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
590
    {
Chong Yidong's avatar
Chong Yidong committed
591 592 593
      /* We initialize the image cache when creating the first frame
	 on a terminal, and not during terminal creation.  This way,
	 `x-open-connection' on a tty won't create an image cache.  */
594 595 596
      if (FRAME_IMAGE_CACHE (f) == NULL)
	FRAME_IMAGE_CACHE (f) = make_image_cache ();
      ++FRAME_IMAGE_CACHE (f)->refcount;
Gerd Moellmann's avatar
Gerd Moellmann committed
597
    }
598
#endif /* HAVE_WINDOW_SYSTEM */
599

600 601 602
  /* Realize faces early (Bug#17889).  */
  if (!realize_basic_faces (f))
    emacs_abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
603
}
604 605


606 607
/* Free face cache of frame F.  Called from frame-dependent
   resource freeing function, e.g. (x|tty)_free_frame_resources.  */
608

Gerd Moellmann's avatar
Gerd Moellmann committed
609
void
610
free_frame_faces (struct frame *f)
611
{
Gerd Moellmann's avatar
Gerd Moellmann committed
612
  struct face_cache *face_cache = FRAME_FACE_CACHE (f);
613

Gerd Moellmann's avatar
Gerd Moellmann committed
614 615 616 617 618
  if (face_cache)
    {
      free_face_cache (face_cache);
      FRAME_FACE_CACHE (f) = NULL;
    }
619

620 621
#ifdef HAVE_WINDOW_SYSTEM
  if (FRAME_WINDOW_P (f))
622
    {
623
      struct image_cache *image_cache = FRAME_IMAGE_CACHE (f);
Gerd Moellmann's avatar
Gerd Moellmann committed
624
      if (image_cache)
625
	{
Gerd Moellmann's avatar
Gerd Moellmann committed
626 627 628
	  --image_cache->refcount;
	  if (image_cache->refcount == 0)
	    free_image_cache (f);
629 630
	}
    }
631
#endif /* HAVE_WINDOW_SYSTEM */
632 633
}

Gerd Moellmann's avatar
Gerd Moellmann committed
634

635 636 637
/* Clear face caches, and recompute basic faces for frame F.  Call
   this after changing frame parameters on which those faces depend,
   or when realized faces have been freed due to changing attributes
638
   of named faces.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
639 640

void
641
recompute_basic_faces (struct frame *f)
642
{
Gerd Moellmann's avatar
Gerd Moellmann committed
643 644
  if (FRAME_FACE_CACHE (f))
    {
Paul Eggert's avatar
Paul Eggert committed
645
      clear_face_cache (false);
646
      if (!realize_basic_faces (f))
647
	emacs_abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
648 649
    }
}
650 651


Paul Eggert's avatar
Paul Eggert committed
652
/* Clear the face caches of all frames.  CLEAR_FONTS_P means
Gerd Moellmann's avatar
Gerd Moellmann committed
653
   try to free unused fonts, too.  */
654

655
void
656
clear_face_cache (bool clear_fonts_p)
657
{
658
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
659
  Lisp_Object tail, frame;
660

Gerd Moellmann's avatar
Gerd Moellmann committed
661 662
  if (clear_fonts_p
      || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
663
    {
Gerd Moellmann's avatar
Gerd Moellmann committed
664 665 666 667
      /* From time to time see if we can unload some fonts.  This also
	 frees all realized faces on all frames.  Fonts needed by
	 faces will be loaded again when faces are realized again.  */
      clear_font_table_count = 0;
668

Gerd Moellmann's avatar
Gerd Moellmann committed
669
      FOR_EACH_FRAME (tail, frame)
670
	{
671
	  struct frame *f = XFRAME (frame);
672
	  if (FRAME_WINDOW_P (f)
673
	      && FRAME_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
674 675 676 677
	    {
	      clear_font_cache (f);
	      free_all_realized_faces (frame);
	    }
Gerd Moellmann's avatar
Gerd Moellmann committed
678 679 680 681 682 683 684
	}
    }
  else
    {
      /* Clear GCs of realized faces.  */
      FOR_EACH_FRAME (tail, frame)
	{
685
	  struct frame *f = XFRAME (frame);
686
	  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
687
	      clear_face_gcs (FRAME_FACE_CACHE (f));
688
	}
689
      clear_image_caches (Qnil);
690
    }
691
#endif /* HAVE_WINDOW_SYSTEM */
692 693
}

Paul Eggert's avatar
Paul Eggert committed
694
DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
695 696
       doc: /* Clear face caches on all frames.
Optional THOROUGHLY non-nil means try to free unused fonts, too.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
697
  (Lisp_Object thoroughly)
698
{
699
  clear_face_cache (!NILP (thoroughly));
700
  face_change = true;
701
  windows_or_buffers_changed = 53;
Gerd Moellmann's avatar
Gerd Moellmann committed
702 703 704 705 706 707 708 709
  return Qnil;
}


/***********************************************************************
			      X Pixmaps
 ***********************************************************************/

710
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
711

712
DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
713
       doc: /* Value is non-nil if OBJECT is a valid bitmap specification.
Gerd Moellmann's avatar
Gerd Moellmann committed
714
A bitmap specification is either a string, a file name, or a list
715
\(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
Gerd Moellmann's avatar
Gerd Moellmann committed
716 717
HEIGHT is its height, and DATA is a string containing the bits of
the pixmap.  Bits are stored row by row, each row occupies
718
\(WIDTH + 7)/8 bytes.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
719
  (Lisp_Object object)
Gerd Moellmann's avatar
Gerd Moellmann committed
720
{
Paul Eggert's avatar
Paul Eggert committed
721
  bool pixmap_p = false;
722

723 724
  if (STRINGP (object))
    /* If OBJECT is a string, it's a file name.  */
Paul Eggert's avatar
Paul Eggert committed
725
    pixmap_p = true;
726 727 728
  else if (CONSP (object))
    {
      /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
729
	 HEIGHT must be ints > 0, and DATA must be string large
730 731 732 733
	 enough to hold a bitmap of the specified size.  */
      Lisp_Object width, height, data;

      height = width = data = Qnil;
734

735 736 737 738 739 740 741 742 743 744 745 746
      if (CONSP (object))
	{
	  width = XCAR (object);
	  object = XCDR (object);
	  if (CONSP (object))
	    {
	      height = XCAR (object);
	      object = XCDR (object);
	      if (CONSP (object))
		data = XCAR (object);
	    }
	}
747

748
      if (STRINGP (data)
749 750
	  && RANGED_FIXNUMP (1, width, INT_MAX)
	  && RANGED_FIXNUMP (1, height, INT_MAX))
751
	{
Tom Tromey's avatar
Tom Tromey committed
752 753
	  int bytes_per_row = (XFIXNUM (width) + CHAR_BIT - 1) / CHAR_BIT;
	  if (XFIXNUM (height) <= SBYTES (data) / bytes_per_row)
Paul Eggert's avatar
Paul Eggert committed
754
	    pixmap_p = true;
755 756 757 758
	}
    }

  return pixmap_p ? Qt : Qnil;
759 760 761
}


Gerd Moellmann's avatar
Gerd Moellmann committed
762 763 764 765
/* Load a bitmap according to NAME (which is either a file name or a
   pixmap spec) for use on frame F.  Value is the bitmap_id (see
   xfns.c).  If NAME is nil, return with a bitmap id of zero.  If
   bitmap cannot be loaded, display a message saying so, and return
766
   zero.  */
767

768
static ptrdiff_t
769
load_pixmap (struct frame *f, Lisp_Object name)
770
{
771
  ptrdiff_t bitmap_id;
772 773

  if (NILP (name))
Gerd Moellmann's avatar
Gerd Moellmann committed
774
    return 0;
775

Kim F. Storm's avatar
Kim F. Storm committed
776
  CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name);
777

778
  block_input ();
779 780 781 782 783 784 785
  if (CONSP (name))
    {
      /* Decode a bitmap spec into a bitmap.  */

      int h, w;
      Lisp_Object bits;

Tom Tromey's avatar
Tom Tromey committed
786 787
      w = XFIXNUM (Fcar (name));
      h = XFIXNUM (Fcar (Fcdr (name)));
788 789
      bits = Fcar (Fcdr (Fcdr (name)));

790 791
      bitmap_id = image_create_bitmap_from_data (f, SSDATA (bits),
                                                 w, h);
792 793 794 795
    }
  else
    {
      /* It must be a string -- a file name.  */
796
      bitmap_id = image_create_bitmap_from_file (f, name);
797
    }
798
  unblock_input ();
799

800
  if (bitmap_id < 0)
Gerd Moellmann's avatar
Gerd Moellmann committed
801
    {
802
      add_to_log ("Invalid or undefined bitmap `%s'", name);
Gerd Moellmann's avatar
Gerd Moellmann committed
803 804 805 806
      bitmap_id = 0;
    }
  else
    {
807
#ifdef GLYPH_DEBUG
Gerd Moellmann's avatar
Gerd Moellmann committed
808 809 810
      ++npixmaps_allocated;
#endif
    }
811 812

  return bitmap_id;
813
}
Morten Welinder's avatar
Morten Welinder committed
814

815
#endif /* HAVE_WINDOW_SYSTEM */
Gerd Moellmann's avatar
Gerd Moellmann committed
816

Morten Welinder's avatar
Morten Welinder committed
817

Gerd Moellmann's avatar
Gerd Moellmann committed
818 819

/***********************************************************************
820
                            Color Handling
Gerd Moellmann's avatar
Gerd Moellmann committed
821 822
 ***********************************************************************/

823 824 825 826
/* Parse hex color component specification that starts at S and ends
   right before E.  Set *DST to the parsed value normalized so that
   the maximum value for the number of hex digits given becomes 65535,
   and return true on success, false otherwise.  */
827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851
static bool
parse_hex_color_comp (const char *s, const char *e, unsigned short *dst)
{
  int n = e - s;
  if (n <= 0 || n > 4)
    return false;
  int val = 0;
  for (; s < e; s++)
    {
      int digit;
      if (*s >= '0' && *s <= '9')
        digit = *s - '0';
      else if (*s >= 'A' && *s <= 'F')
        digit = *s - 'A' + 10;
      else if (*s >= 'a' && *s <= 'f')
        digit = *s - 'a' + 10;
      else
        return false;
      val = (val << 4) | digit;
    }
  int maxval = (1 << (n * 4)) - 1;
  *dst = (unsigned)val * 65535 / maxval;
  return true;
}

852 853 854
/* Parse floating-point color component specification that starts at S
   and ends right before E.  Return the parsed number if in the range
   [0,1]; otherwise return -1.  */
855 856 857 858 859 860 861 862
static double
parse_float_color_comp (const char *s, const char *e)
{
  char *end;
  double x = strtod (s, &end);
  return (end == e && x >= 0 && x <= 1) ? x : -1;
}

863
/* Parse SPEC as a numeric color specification and set *R, *G and *B.
864 865
   Return true on success, false on failure.

866
   Recognized formats of SPEC:
867

868 869 870 871 872 873 874
    "#RGB", with R, G and B hex strings of equal length, 1-4 digits each.
    "rgb:R/G/B", with R, G and B hex strings, 1-4 digits each.
    "rgbi:R/G/B", with R, G and B numbers in [0,1].

   If the function succeeds, it assigns to each of the components *R,
   *G, and *B a value normalized to be in the [0, 65535] range.  If
   the function fails, some or all of the components remain unassigned.  */
875
bool
876
parse_color_spec (const char *spec,
877 878
                  unsigned short *r, unsigned short *g, unsigned short *b)
{
879 880
  int len = strlen (spec);
  if (spec[0] == '#')
881 882 883 884
    {
      if ((len - 1) % 3 == 0)
        {
          int n = (len - 1) / 3;
885 886 887 888 889 890
          return (   parse_hex_color_comp (spec + 1 + 0 * n,
					   spec + 1 + 1 * n, r)
                  && parse_hex_color_comp (spec + 1 + 1 * n,
					   spec + 1 + 2 * n, g)
                  && parse_hex_color_comp (spec + 1 + 2 * n,
					   spec + 1 + 3 * n, b));
891 892
        }
    }
893
  else if (strncmp (spec, "rgb:", 4) == 0)
894 895
    {
      char *sep1, *sep2;
896
      return ((sep1 = strchr (spec + 4, '/')) != NULL
897
              && (sep2 = strchr (sep1 + 1, '/')) != NULL
898
              && parse_hex_color_comp (spec + 4, sep1, r)
899
              && parse_hex_color_comp (sep1 + 1, sep2, g)
900
              && parse_hex_color_comp (sep2 + 1, spec + len, b));
901
    }
902
  else if (strncmp (spec, "rgbi:", 5) == 0)
903 904 905
    {
      char *sep1, *sep2;
      double red, green, blue;
906
      if ((sep1 = strchr (spec + 5, '/')) != NULL
907
          && (sep2 = strchr (sep1 + 1, '/')) != NULL
908
          && (red = parse_float_color_comp (spec + 5, sep1)) >= 0
909
          && (green = parse_float_color_comp (sep1 + 1, sep2)) >= 0
910
          && (blue = parse_float_color_comp (sep2 + 1, spec + len)) >= 0)
911 912 913 914 915 916 917 918 919 920
        {
          *r = lrint (red * 65535);
          *g = lrint (green * 65535);
          *b = lrint (blue * 65535);
          return true;
        }
    }
  return false;
}

921 922 923
DEFUN ("color-values-from-color-spec",
       Fcolor_values_from_color_spec,
       Scolor_values_from_color_spec,
924
       1, 1, 0,
925 926 927 928 929 930
       doc: /* Parse color SPEC as a numeric color and return (RED GREEN BLUE).
This function recognises the following formats for SPEC:

 #RGB, where R, G and B are hex numbers of equal length, 1-4 digits each.
 rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each.
 rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1].
931

932
If SPEC is not in one of the above forms, return nil.
933

934 935 936
Each of the 3 integer members of the resulting list, RED, GREEN, and BLUE,
is normalized to have its value in [0,65535].  */)
  (Lisp_Object spec)
937
{
938
  CHECK_STRING (spec);
939
  unsigned short r, g, b;
940
  return (parse_color_spec (SSDATA (spec), &r, &g, &b)
941 942 943 944
          ? list3i (r, g, b)
          : Qnil);
}

945 946
/* Parse RGB_LIST, and fill in the RGB fields of COLOR.
   RGB_LIST should contain (at least) 3 lisp integers.
Paul Eggert's avatar
Paul Eggert committed
947
   Return true iff RGB_LIST is OK.  */
948

Paul Eggert's avatar
Paul Eggert committed
949
static bool
950
parse_rgb_list (Lisp_Object rgb_list, Emacs_Color *color)
951 952
{
#define PARSE_RGB_LIST_FIELD(field)					\
953
  if (CONSP (rgb_list) && FIXNUMP (XCAR (rgb_list)))			\
954
    {									\
Tom Tromey's avatar
Tom Tromey committed
955
      color->field = XFIXNUM (XCAR (rgb_list));				\
956 957 958
      rgb_list = XCDR (rgb_list);					\
    }									\
  else									\
Paul Eggert's avatar
Paul Eggert committed
959
    return false;
960 961 962 963 964

  PARSE_RGB_LIST_FIELD (red);
  PARSE_RGB_LIST_FIELD (green);
  PARSE_RGB_LIST_FIELD (blue);

Paul Eggert's avatar
Paul Eggert committed
965
  return true;
966 967 968 969 970 971 972 973
}


/* Lookup on frame F the color described by the lisp string COLOR.
   The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
   non-zero, then the `standard' definition of the same color is
   returned in it.  */

974
static bool
975 976
tty_lookup_color (struct frame *f, Lisp_Object color, Emacs_Color *tty_color,
		  Emacs_Color *std_color)
977 978 979 980
{
  Lisp_Object frame, color_desc;

  if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc)))
Paul Eggert's avatar
Paul Eggert committed
981
    return false;
982 983 984 985 986 987 988 989

  XSETFRAME (frame, f);

  color_desc = call2 (Qtty_color_desc, color, frame);
  if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
    {
      Lisp_Object rgb;

990
      if (! FIXNUMP (XCAR (XCDR (color_desc))))
Paul Eggert's avatar
Paul Eggert committed
991
	return false;
992

Tom Tromey's avatar
Tom Tromey committed
993
      tty_color->pixel = XFIXNUM (XCAR (XCDR (color_desc)));
994 995 996

      rgb = XCDR (XCDR (color_desc));
      if (! parse_rgb_list (rgb, tty_color))
Paul Eggert's avatar
Paul Eggert committed
997
	return false;
998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010

      /* Should we fill in STD_COLOR too?  */
      if (std_color)
	{
	  /* Default STD_COLOR to the same as TTY_COLOR.  */
	  *std_color = *tty_color;

	  /* Do a quick check to see if the returned descriptor is
	     actually _exactly_ equal to COLOR, otherwise we have to
	     lookup STD_COLOR separately.  If it's impossible to lookup
	     a standard color, we just give up and use TTY_COLOR.  */
	  if ((!STRINGP (XCAR (color_desc))
	       || NILP (Fstring_equal (color, XCAR (color_desc))))
1011
	      && !NILP (Ffboundp (Qtty_color_standard_values)))
1012 1013 1014 1015
	    {
	      /* Look up STD_COLOR separately.  */
	      rgb = call1 (Qtty_color_standard_values, color);
	      if (! parse_rgb_list (rgb, std_color))
Paul Eggert's avatar
Paul Eggert committed
1016
		return false;
1017 1018 1019
	    }
	}

Paul Eggert's avatar
Paul Eggert committed
1020
      return true;
1021 1022 1023 1024 1025