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

3
Copyright (C) 1993-1994, 1998-2012  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 <http://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

Miles Bader's avatar
Miles Bader committed
71 72
   15. A face name or list of face names from which to inherit attributes.

73 74 75 76
   16. A specified average font width, which is invisible from Lisp,
   and is used to ensure that a font specified on the command line,
   for example, can be matched exactly.

77 78 79 80 81
   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.

Kenichi Handa's avatar
Kenichi Handa committed
82

Gerd Moellmann's avatar
Gerd Moellmann committed
83 84 85 86
   Faces are frame-local by nature because Emacs allows to define the
   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
87 88
   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
89 90 91 92

   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.
93

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


   Face merging.

   The display style of a given character in the text is determined by
   combining several faces.  This process is called `face merging'.
   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.


   Face realization.
110

Gerd Moellmann's avatar
Gerd Moellmann committed
111 112 113 114 115 116 117
   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
   `realized face' in form of a struct face which is stored in the
   face cache of the frame on which it was realized.

118 119 120 121
   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
122 123
   them.

124 125 126 127 128 129 130 131 132 133
   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
134
   Thus, all realized faces have a realized fontset.
Gerd Moellmann's avatar
Gerd Moellmann committed
135 136 137 138


   Unibyte text.

139 140 141 142 143
   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
144 145 146 147

   Font selection.

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

150 151 152 153 154 155
   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
156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171

   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.

172
   2. Setting face-font-family-alternatives allows the user to
Gerd Moellmann's avatar
Gerd Moellmann committed
173 174 175
   specify alternative font families to try if a family specified by a
   face doesn't exist.

176 177 178 179 180 181 182
   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
183

Stefan Monnier's avatar
Typos.  
Stefan Monnier committed
184
   Character composition.
185 186 187 188 189 190 191 192

   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
193

194

Gerd Moellmann's avatar
Gerd Moellmann committed
195 196 197 198 199 200 201
   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.  */

202
#include <config.h>
Kenichi Handa's avatar
Kenichi Handa committed
203
#include <stdio.h>
Jim Blandy's avatar
Jim Blandy committed
204 205
#include <sys/types.h>
#include <sys/stat.h>
206
#include <stdio.h>              /* This needs to be before termchar.h */
207

Jim Blandy's avatar
Jim Blandy committed
208
#include "lisp.h"
209
#include "character.h"
Karl Heuer's avatar
Karl Heuer committed
210
#include "charset.h"
211
#include "keyboard.h"
212
#include "frame.h"
213
#include "termhooks.h"
214

Morten Welinder's avatar
Morten Welinder committed
215
#ifdef HAVE_X_WINDOWS
Jim Blandy's avatar
Jim Blandy committed
216
#include "xterm.h"
217 218 219 220
#ifdef USE_MOTIF
#include <Xm/Xm.h>
#include <Xm/XmStrDefs.h>
#endif /* USE_MOTIF */
221
#endif /* HAVE_X_WINDOWS */
Gerd Moellmann's avatar
Gerd Moellmann committed
222

Morten Welinder's avatar
Morten Welinder committed
223 224 225
#ifdef MSDOS
#include "dosfns.h"
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
226

227 228
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
229
#include "fontset.h"
230
#ifdef WINDOWSNT
231
#undef FRAME_X_DISPLAY_INFO
232 233 234 235
#define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
#define x_display_info w32_display_info
#define check_x check_w32
#define GCGraphicsExposures 0
236
#endif /* WINDOWSNT */
237

238 239 240 241 242 243 244
#ifdef HAVE_NS
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
#define x_display_info ns_display_info
#define check_x check_ns
#define GCGraphicsExposures 0
#endif /* HAVE_NS */
245
#endif /* HAVE_WINDOW_SYSTEM */
246

Jim Blandy's avatar
Jim Blandy committed
247
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
248
#include "dispextern.h"
Jim Blandy's avatar
Jim Blandy committed
249
#include "blockinput.h"
250
#include "window.h"
Karl Heuer's avatar
Karl Heuer committed
251
#include "intervals.h"
252
#include "termchar.h"
Jim Blandy's avatar
Jim Blandy committed
253

Kenichi Handa's avatar
Kenichi Handa committed
254 255
#include "font.h"

Morten Welinder's avatar
Morten Welinder committed
256
#ifdef HAVE_X_WINDOWS
Gerd Moellmann's avatar
Gerd Moellmann committed
257 258

/* Compensate for a bug in Xos.h on some systems, on which it requires
259 260 261 262
   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
263
#ifdef XOS_NEEDS_TIME_H
264
#include <time.h>
265 266 267
#undef USG
#include <X11/Xos.h>
#define USG
268
#define __TIMEVAL__
269 270
#if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros.  */
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
271 272 273
#else /* not XOS_NEEDS_TIME_H */
#include <X11/Xos.h>
#endif /* not XOS_NEEDS_TIME_H */
274

Gerd Moellmann's avatar
Gerd Moellmann committed
275
#endif /* HAVE_X_WINDOWS */
276

277
#include <c-ctype.h>
Jim Blandy's avatar
Jim Blandy committed
278

Gerd Moellmann's avatar
Gerd Moellmann committed
279 280 281 282
/* Number of pt per inch (from the TeXbook).  */

#define PT_PER_INCH 72.27

Gerd Moellmann's avatar
Gerd Moellmann committed
283 284 285 286
/* Non-zero if face attribute ATTR is unspecified.  */

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

287 288
/* Non-zero if face attribute ATTR is `ignore-defface'.  */

289
#define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
290

Gerd Moellmann's avatar
Gerd Moellmann committed
291 292 293 294
/* Value is the number of elements of VECTOR.  */

#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))

295
/* Size of hash table of realized faces in face caches (should be a
Gerd Moellmann's avatar
Gerd Moellmann committed
296 297 298 299 300 301
   prime number).  */

#define FACE_CACHE_BUCKETS_SIZE 1001

/* Keyword symbols used for face attribute names.  */

302 303 304 305 306 307 308 309 310
Lisp_Object QCfamily, QCheight, QCweight, QCslant;
static Lisp_Object QCunderline;
static Lisp_Object QCinverse_video, QCstipple;
Lisp_Object QCforeground, QCbackground;
Lisp_Object QCwidth;
static Lisp_Object QCfont, QCbold, QCitalic;
static Lisp_Object QCreverse_video;
static Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
static Lisp_Object QCfontset;
Gerd Moellmann's avatar
Gerd Moellmann committed
311 312 313

/* Symbols used for attribute values.  */

314
Lisp_Object Qnormal;
315
Lisp_Object Qbold;
316
static Lisp_Object Qline, Qwave;
Paul Eggert's avatar
Paul Eggert committed
317 318
static Lisp_Object Qultra_light, Qreverse_oblique, Qreverse_italic;
Lisp_Object Qextra_light, Qlight;
319
Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
Paul Eggert's avatar
Paul Eggert committed
320
Lisp_Object Qoblique;
321 322 323 324 325
Lisp_Object Qitalic;
static Lisp_Object Qultra_condensed, Qextra_condensed;
Lisp_Object Qcondensed;
static Lisp_Object Qsemi_condensed, Qsemi_expanded, Qextra_expanded;
Lisp_Object Qexpanded;
326 327 328
static Lisp_Object Qultra_expanded;
static Lisp_Object Qreleased_button, Qpressed_button;
static Lisp_Object QCstyle, QCcolor, QCline_width;
329
Lisp_Object Qunspecified;	/* used in dosfns.c */
330
static Lisp_Object QCignore_defface;
331 332

char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
Gerd Moellmann's avatar
Gerd Moellmann committed
333

334
/* The name of the function to call when the background of the frame
335
   has changed, frame_set_background_mode.  */
336

337
static Lisp_Object Qframe_set_background_mode;
338

Gerd Moellmann's avatar
Gerd Moellmann committed
339 340
/* Names of basic faces.  */

341 342 343 344 345 346
Lisp_Object Qdefault, Qtool_bar, Qfringe;
static Lisp_Object Qregion;
Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
static Lisp_Object Qborder, Qmouse, Qmenu;
Lisp_Object Qmode_line_inactive;
static Lisp_Object Qvertical_border;
347

348 349 350 351
/* The symbol `face-alias'.  A symbols having that property is an
   alias for another face.  Value of the property is the name of
   the aliased face.  */

352
static Lisp_Object Qface_alias;
353

Gerd Moellmann's avatar
Gerd Moellmann committed
354 355 356 357 358 359
/* 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;

360 361 362 363 364 365
/* 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
366 367 368 369 370 371
/* Allowed scalable fonts.  A value of nil means don't allow any
   scalable fonts.  A value of t means allow the use of any scalable
   font.  Otherwise, value must be a list of regular expressions.  A
   font may be scaled if its name matches a regular expression in the
   list.  */

372
static Lisp_Object Qscalable_fonts_allowed;
373

Gerd Moellmann's avatar
Gerd Moellmann committed
374 375
#define DEFAULT_FONT_LIST_LIMIT 100

Gerd Moellmann's avatar
Gerd Moellmann committed
376 377 378 379 380 381 382
/* The symbols `foreground-color' and `background-color' which can be
   used as part of a `face' property.  This is for compatibility with
   Emacs 20.2.  */

Lisp_Object Qforeground_color, Qbackground_color;

/* The symbols `face' and `mouse-face' used as text properties.  */
Jim Blandy's avatar
Jim Blandy committed
383

384
Lisp_Object Qface;
Gerd Moellmann's avatar
Gerd Moellmann committed
385

Kim F. Storm's avatar
Kim F. Storm committed
386 387
/* Property for basic faces which other faces cannot inherit.  */

388
static Lisp_Object Qface_no_inherit;
Kim F. Storm's avatar
Kim F. Storm committed
389

Gerd Moellmann's avatar
Gerd Moellmann committed
390 391
/* Error symbol for wrong_type_argument in load_pixmap.  */

392
static Lisp_Object Qbitmap_spec_p;
Jim Blandy's avatar
Jim Blandy committed
393

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

Gerd Moellmann's avatar
Gerd Moellmann committed
396
static int next_lface_id;
Jim Blandy's avatar
Jim Blandy committed
397

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

Gerd Moellmann's avatar
Gerd Moellmann committed
400
static Lisp_Object *lface_id_to_name;
401
static ptrdiff_t lface_id_to_name_size;
Jim Blandy's avatar
Jim Blandy committed
402

403 404
/* TTY color-related functions (defined in tty-colors.el).  */

405
static Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
Gerd Moellmann's avatar
Gerd Moellmann committed
406

407 408
/* The name of the function used to compute colors on TTYs.  */

409
static Lisp_Object Qtty_color_alist;
410

Gerd Moellmann's avatar
Gerd Moellmann committed
411 412 413 414 415 416 417 418 419 420 421 422 423
/* 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

/* Non-zero means face attributes have been changed since the last
   redisplay.  Used in redisplay_internal.  */

int face_change_count;

424 425 426 427 428
/* Non-zero means don't display bold text if a face's foreground
   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.  */

429
static int tty_suppress_bold_inverse_default_colors_p;
430

431 432 433 434 435
/* A list of the form `((x . y))' used to avoid consing in
   Finternal_set_lisp_face_attribute.  */

static Lisp_Object Vparam_value_alist;

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

438
#ifdef GLYPH_DEBUG
Gerd Moellmann's avatar
Gerd Moellmann committed
439 440 441 442 443
static int ncolors_allocated;
static int npixmaps_allocated;
static int ngcs;
#endif

444 445 446
/* Non-zero means the definition of the `menu' face for new frames has
   been changed.  */

447
static int menu_face_changed_default;
Gerd Moellmann's avatar
Gerd Moellmann committed
448 449 450 451 452


/* Function prototypes.  */

struct table_entry;
453
struct named_merge_point;
Gerd Moellmann's avatar
Gerd Moellmann committed
454

455 456
static void set_font_frame_param (Lisp_Object, Lisp_Object);
static struct face *realize_face (struct face_cache *, Lisp_Object *,
Andreas Schwab's avatar
Andreas Schwab committed
457
				  int);
458
static struct face *realize_non_ascii_face (struct frame *, Lisp_Object,
Andreas Schwab's avatar
Andreas Schwab committed
459
					    struct face *);
460 461 462 463 464 465 466 467 468
static struct face *realize_x_face (struct face_cache *, Lisp_Object *);
static struct face *realize_tty_face (struct face_cache *, Lisp_Object *);
static int realize_basic_faces (struct frame *);
static int realize_default_face (struct frame *);
static void realize_named_face (struct frame *, Lisp_Object, int);
static struct face_cache *make_face_cache (struct frame *);
static void clear_face_gcs (struct face_cache *);
static void free_face_cache (struct face_cache *);
static int merge_face_ref (struct frame *, Lisp_Object, Lisp_Object *,
Andreas Schwab's avatar
Andreas Schwab committed
469
			   int, struct named_merge_point *);
Jim Blandy's avatar
Jim Blandy committed
470

471

Gerd Moellmann's avatar
Gerd Moellmann committed
472 473 474
/***********************************************************************
			      Utilities
 ***********************************************************************/
Jim Blandy's avatar
Jim Blandy committed
475

Morten Welinder's avatar
Morten Welinder committed
476
#ifdef HAVE_X_WINDOWS
477

478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495
#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
496
register_color (unsigned long pixel)
497
{
498
  eassert (pixel < 256);
499 500 501 502 503 504 505
  ++color_count[pixel];
}


/* Register color PIXEL as deallocated.  */

void
Andreas Schwab's avatar
Andreas Schwab committed
506
unregister_color (unsigned long pixel)
507
{
508
  eassert (pixel < 256);
509 510 511
  if (color_count[pixel] > 0)
    --color_count[pixel];
  else
512
    emacs_abort ();
513 514 515 516 517 518
}


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

void
Andreas Schwab's avatar
Andreas Schwab committed
519
unregister_colors (unsigned long *pixels, int n)
520 521 522 523 524 525
{
  int i;
  for (i = 0; i < n; ++i)
    unregister_color (pixels[i]);
}

526

Paul Eggert's avatar
Paul Eggert committed
527
DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
528
       doc: /* Dump currently allocated colors to stderr.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
529
  (void)
530 531 532 533
{
  int i, n;

  fputc ('\n', stderr);
534

535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550
  for (i = n = 0; i < sizeof color_count / sizeof color_count[0]; ++i)
    if (color_count[i])
      {
	fprintf (stderr, "%3d: %5d", i, color_count[i]);
	++n;
	if (n % 5 == 0)
	  fputc ('\n', stderr);
	else
	  fputc ('\t', stderr);
      }

  if (n % 5 != 0)
    fputc ('\n', stderr);
  return Qnil;
}

551 552
#endif /* DEBUG_X_COLORS */

553

554 555 556 557 558
/* 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
559
x_free_colors (struct frame *f, long unsigned int *pixels, int npixels)
560 561 562 563 564 565 566
{
  int class = FRAME_X_DISPLAY_INFO (f)->visual->class;

  /* If display has an immutable color map, freeing colors is not
     necessary and some servers don't allow it.  So don't do it.  */
  if (class != StaticColor && class != StaticGray && class != TrueColor)
    {
567
#ifdef DEBUG_X_COLORS
568
      unregister_colors (pixels, npixels);
569
#endif
570 571
      XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
		   pixels, npixels, 0);
572 573 574 575
    }
}


576 577
#ifdef USE_X_TOOLKIT

578 579 580 581 582
/* 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
Andreas Schwab's avatar
Andreas Schwab committed
583 584
x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap,
		   long unsigned int *pixels, int npixels)
585 586 587 588 589 590 591 592
{
  struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
  int class = dpyinfo->visual->class;

  /* If display has an immutable color map, freeing colors is not
     necessary and some servers don't allow it.  So don't do it.  */
  if (class != StaticColor && class != StaticGray && class != TrueColor)
    {
593
#ifdef DEBUG_X_COLORS
594
      unregister_colors (pixels, npixels);
595
#endif
596
      XFreeColors (dpy, cmap, pixels, npixels, 0);
597 598
    }
}
599
#endif /* USE_X_TOOLKIT */
600

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

Paul Eggert's avatar
Paul Eggert committed
604
static inline GC
605
x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv)
Jim Blandy's avatar
Jim Blandy committed
606 607
{
  GC gc;
Gerd Moellmann's avatar
Gerd Moellmann committed
608 609 610 611 612 613
  BLOCK_INPUT;
  gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
  UNBLOCK_INPUT;
  IF_DEBUG (++ngcs);
  return gc;
}
Jim Blandy's avatar
Jim Blandy committed
614

615

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

Paul Eggert's avatar
Paul Eggert committed
618
static inline void
619
x_free_gc (struct frame *f, GC gc)
Gerd Moellmann's avatar
Gerd Moellmann committed
620
{
621
  eassert (interrupt_input_blocked);
622
  IF_DEBUG (eassert (--ngcs >= 0));
Gerd Moellmann's avatar
Gerd Moellmann committed
623 624
  XFreeGC (FRAME_X_DISPLAY (f), gc);
}
625

Gerd Moellmann's avatar
Gerd Moellmann committed
626
#endif /* HAVE_X_WINDOWS */
627

628 629 630
#ifdef WINDOWSNT
/* W32 emulation of GCs */

Paul Eggert's avatar
Paul Eggert committed
631
static inline GC
632
x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
633 634 635 636 637 638 639 640 641 642 643 644
{
  GC gc;
  BLOCK_INPUT;
  gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, xgcv);
  UNBLOCK_INPUT;
  IF_DEBUG (++ngcs);
  return gc;
}


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

Paul Eggert's avatar
Paul Eggert committed
645
static inline void
646
x_free_gc (struct frame *f, GC gc)
647
{
648
  IF_DEBUG (eassert (--ngcs >= 0));
649 650 651 652
  xfree (gc);
}

#endif  /* WINDOWSNT */
653

654 655 656
#ifdef HAVE_NS
/* NS emulation of GCs */

Paul Eggert's avatar
Paul Eggert committed
657
static inline GC
658
x_create_gc (struct frame *f,
Andreas Schwab's avatar
Andreas Schwab committed
659 660
	     unsigned long mask,
	     XGCValues *xgcv)
661
{
662
  GC gc = xmalloc (sizeof *gc);
663
  *gc = *xgcv;
664 665 666
  return gc;
}

Paul Eggert's avatar
Paul Eggert committed
667
static inline void
668
x_free_gc (struct frame *f, GC gc)
669
{
670
  xfree (gc);
671 672 673
}
#endif  /* HAVE_NS */

674 675 676 677 678
/* If FRAME is nil, return a pointer to the selected frame.
   Otherwise, check that FRAME is a live frame, and return a pointer
   to it.  NPARAM is the parameter number of FRAME, for
   CHECK_LIVE_FRAME.  This is here because it's a frequent pattern in
   Lisp function definitions.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
679

Paul Eggert's avatar
Paul Eggert committed
680
static inline struct frame *
681
frame_or_selected_frame (Lisp_Object frame, int nparam)
Gerd Moellmann's avatar
Gerd Moellmann committed
682 683
{
  if (NILP (frame))
684
    frame = selected_frame;
685

686
  CHECK_LIVE_FRAME (frame);
687
  return XFRAME (frame);
688
}
Gerd Moellmann's avatar
Gerd Moellmann committed
689

690

Gerd Moellmann's avatar
Gerd Moellmann committed
691 692 693
/***********************************************************************
			   Frames and faces
 ***********************************************************************/
694

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

Gerd Moellmann's avatar
Gerd Moellmann committed
697
void
698
init_frame_faces (struct frame *f)
699
{
Gerd Moellmann's avatar
Gerd Moellmann committed
700 701 702
  /* Make a face cache, if F doesn't have one.  */
  if (FRAME_FACE_CACHE (f) == NULL)
    FRAME_FACE_CACHE (f) = make_face_cache (f);
703

704
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
705
  /* Make the image cache.  */
706
  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
707
    {
Chong Yidong's avatar
Chong Yidong committed
708 709 710
      /* 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.  */
711 712 713
      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
714
    }
715
#endif /* HAVE_WINDOW_SYSTEM */
716

717
  /* Realize basic faces.  Must have enough information in frame
Gerd Moellmann's avatar
Gerd Moellmann committed
718 719 720
     parameters to realize basic faces at this point.  */
#ifdef HAVE_X_WINDOWS
  if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
721 722 723
#endif
#ifdef WINDOWSNT
  if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
Andrew Choi's avatar
Andrew Choi committed
724
#endif
725 726
#ifdef HAVE_NS
  if (!FRAME_NS_P (f) || FRAME_NS_WINDOW (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
727 728
#endif
    if (!realize_basic_faces (f))
729
	emacs_abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
730
}
731 732


733
/* Free face cache of frame F.  Called from delete_frame.  */
734

Gerd Moellmann's avatar
Gerd Moellmann committed
735
void
736
free_frame_faces (struct frame *f)
737
{
Gerd Moellmann's avatar
Gerd Moellmann committed
738
  struct face_cache *face_cache = FRAME_FACE_CACHE (f);
739

Gerd Moellmann's avatar
Gerd Moellmann committed
740 741 742 743 744
  if (face_cache)
    {
      free_face_cache (face_cache);
      FRAME_FACE_CACHE (f) = NULL;
    }
745

746 747
#ifdef HAVE_WINDOW_SYSTEM
  if (FRAME_WINDOW_P (f))
748
    {
749
      struct image_cache *image_cache = FRAME_IMAGE_CACHE (f);
Gerd Moellmann's avatar
Gerd Moellmann committed
750
      if (image_cache)
751
	{
Gerd Moellmann's avatar
Gerd Moellmann committed
752 753 754
	  --image_cache->refcount;
	  if (image_cache->refcount == 0)
	    free_image_cache (f);
755 756
	}
    }
757
#endif /* HAVE_WINDOW_SYSTEM */
758 759
}

Gerd Moellmann's avatar
Gerd Moellmann committed
760

761 762 763 764
/* 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
   of named faces. */
Gerd Moellmann's avatar
Gerd Moellmann committed
765 766

void
767
recompute_basic_faces (struct frame *f)
768
{
Gerd Moellmann's avatar
Gerd Moellmann committed
769 770
  if (FRAME_FACE_CACHE (f))
    {
771
      clear_face_cache (0);
772
      if (!realize_basic_faces (f))
773
	emacs_abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
774 775
    }
}
776 777


Gerd Moellmann's avatar
Gerd Moellmann committed
778 779
/* Clear the face caches of all frames.  CLEAR_FONTS_P non-zero means
   try to free unused fonts, too.  */
780

781
void
782
clear_face_cache (int clear_fonts_p)
783
{
784
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
785
  Lisp_Object tail, frame;
786

Gerd Moellmann's avatar
Gerd Moellmann committed
787 788
  if (clear_fonts_p
      || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
789
    {
790 791 792 793 794
#if 0
      /* Not yet implemented.  */
      clear_font_cache (frame);
#endif

Gerd Moellmann's avatar
Gerd Moellmann committed
795 796 797 798
      /* 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;
799

Gerd Moellmann's avatar
Gerd Moellmann committed
800
      FOR_EACH_FRAME (tail, frame)
801
	{
802
	  struct frame *f = XFRAME (frame);
803
	  if (FRAME_WINDOW_P (f)
Gerd Moellmann's avatar
Gerd Moellmann committed
804
	      && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
805
	    free_all_realized_faces (frame);
Gerd Moellmann's avatar
Gerd Moellmann committed
806 807 808 809 810 811 812
	}
    }
  else
    {
      /* Clear GCs of realized faces.  */
      FOR_EACH_FRAME (tail, frame)
	{
813
	  struct frame *f = XFRAME (frame);
814
	  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
815
	      clear_face_gcs (FRAME_FACE_CACHE (f));
816
	}
817
      clear_image_caches (Qnil);
818
    }
819
#endif /* HAVE_WINDOW_SYSTEM */
820 821
}

Gerd Moellmann's avatar
Gerd Moellmann committed
822

Paul Eggert's avatar
Paul Eggert committed
823
DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
824 825
       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
826
  (Lisp_Object thoroughly)
827
{
828
  clear_face_cache (!NILP (thoroughly));
829 830
  ++face_change_count;
  ++windows_or_buffers_changed;
Gerd Moellmann's avatar
Gerd Moellmann committed
831 832 833 834 835 836 837 838
  return Qnil;
}

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

839
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
840

841
DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
842
       doc: /* Value is non-nil if OBJECT is a valid bitmap specification.
Gerd Moellmann's avatar
Gerd Moellmann committed
843 844 845 846
A bitmap specification is either a string, a file name, or a list
\(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
HEIGHT is its height, and DATA is a string containing the bits of
the pixmap.  Bits are stored row by row, each row occupies
847
\(WIDTH + 7)/8 bytes.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
848
  (Lisp_Object object)
Gerd Moellmann's avatar
Gerd Moellmann committed
849
{
850
  int pixmap_p = 0;
851

852 853 854 855 856 857
  if (STRINGP (object))
    /* If OBJECT is a string, it's a file name.  */
    pixmap_p = 1;
  else if (CONSP (object))
    {
      /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
858
	 HEIGHT must be ints > 0, and DATA must be string large
859 860 861 862
	 enough to hold a bitmap of the specified size.  */
      Lisp_Object width, height, data;

      height = width = data = Qnil;
863

864 865 866 867 868 869 870 871 872 873 874 875
      if (CONSP (object))
	{
	  width = XCAR (object);
	  object = XCDR (object);
	  if (CONSP (object))
	    {
	      height = XCAR (object);
	      object = XCDR (object);
	      if (CONSP (object))
		data = XCAR (object);
	    }
	}
876

877
      if (STRINGP (data)
878 879
	  && RANGED_INTEGERP (1, width, INT_MAX)
	  && RANGED_INTEGERP (1, height, INT_MAX))
880
	{
881 882
	  int bytes_per_row = ((XINT (width) + BITS_PER_CHAR - 1)
			       / BITS_PER_CHAR);
883
	  if (XINT (height) <= SBYTES (data) / bytes_per_row)
884 885 886 887 888
	    pixmap_p = 1;
	}
    }

  return pixmap_p ? Qt : Qnil;
889 890 891
}


Gerd Moellmann's avatar
Gerd Moellmann committed
892 893 894 895 896 897
/* 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
   zero.  Store the bitmap width in *W_PTR and its height in *H_PTR,
   if these pointers are not null.  */
898

899
static ptrdiff_t
Andreas Schwab's avatar
Andreas Schwab committed
900 901
load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr,
	     unsigned int *h_ptr)
902
{
903
  ptrdiff_t bitmap_id;
904 905

  if (NILP (name))
Gerd Moellmann's avatar
Gerd Moellmann committed
906
    return 0;
907

Kim F. Storm's avatar
Kim F. Storm committed
908
  CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name);
909 910 911 912 913 914 915 916 917 918 919 920 921

  BLOCK_INPUT;
  if (CONSP (name))
    {
      /* Decode a bitmap spec into a bitmap.  */

      int h, w;
      Lisp_Object bits;

      w = XINT (Fcar (name));
      h = XINT (Fcar (Fcdr (name)));
      bits = Fcar (Fcdr (Fcdr (name)));

922
      bitmap_id = x_create_bitmap_from_data (f, SSDATA (bits),
923 924 925 926 927 928 929 930 931
					     w, h);
    }
  else
    {
      /* It must be a string -- a file name.  */
      bitmap_id = x_create_bitmap_from_file (f, name);
    }
  UNBLOCK_INPUT;

932
  if (bitmap_id < 0)
Gerd Moellmann's avatar
Gerd Moellmann committed
933
    {
934
      add_to_log ("Invalid or undefined bitmap `%s'", name, Qnil);
Gerd Moellmann's avatar
Gerd Moellmann committed
<