xfaces.c 248 KB
Newer Older
Gerd Moellmann's avatar
Gerd Moellmann committed
1
/* xfaces.c -- "Face" primitives.
2
   Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
Glenn Morris's avatar
Glenn Morris committed
3
                 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4

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

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

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
along with GNU Emacs; see the file COPYING.  If not, write to
Lute Kamstra's avatar
Lute Kamstra committed
19 20
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */
Jim Blandy's avatar
Jim Blandy committed
21

Gerd Moellmann's avatar
Gerd Moellmann committed
22 23 24 25 26 27 28 29
/* 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:

30
   1. Font family name.
31

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

35
   3. Font height in 1/10pt.
36

Gerd Moellmann's avatar
Gerd Moellmann committed
37
   4. Font weight, e.g. `bold'.
38

Gerd Moellmann's avatar
Gerd Moellmann committed
39
   5. Font slant, e.g. `italic'.
40

Gerd Moellmann's avatar
Gerd Moellmann committed
41
   6. Foreground color.
42

Gerd Moellmann's avatar
Gerd Moellmann committed
43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
   7. Background color.

   8. Whether or not characters should be underlined, and in what color.

   9. Whether or not characters should be displayed in inverse video.

   10. A background stipple, a bitmap.

   11. Whether or not characters should be overlined, and in what color.

   12. Whether or not characters should be strike-through, and in what
   color.

   13. Whether or not a box should be drawn around characters, the box
   type, and, for simple boxes, in what color.

Kenichi Handa's avatar
Kenichi Handa committed
59
   14. Font pattern, or nil.  This is a special attribute.
Stefan Monnier's avatar
Typos.  
Stefan Monnier committed
60
   When this attribute is specified, the face uses a font opened by
61 62 63 64 65 66 67 68
   that pattern as is.  In addition, all the other font-related
   attributes (1st thru 5th) are generated from the opened font name.
   On the other hand, if one of the other font-related attributes are
   specified, this attribute is set to nil.  In that case, the face
   doesn't inherit this attribute from the `default' face, and uses a
   font determined by the other attributes (those may be inherited
   from the `default' face).

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

71 72 73 74
   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.

Kenichi Handa's avatar
Kenichi Handa committed
75 76
   17. A fontset name.

Gerd Moellmann's avatar
Gerd Moellmann committed
77 78 79 80
   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
81 82
   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
83 84 85 86

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

Gerd Moellmann's avatar
Gerd Moellmann committed
88
   A face doesn't have to specify all attributes.  Those not specified
89 90
   have a value of `unspecified'.  Faces specifying all attributes but
   the 14th are called `fully-specified'.
Gerd Moellmann's avatar
Gerd Moellmann committed
91 92 93 94 95 96 97 98 99 100 101 102 103


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

Gerd Moellmann's avatar
Gerd Moellmann committed
105 106 107 108 109 110 111
   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.

112 113 114 115
   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
116 117
   them.

118 119 120 121 122 123 124 125 126 127
   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
128
   Thus, all realized faces have a realized fontset.
Gerd Moellmann's avatar
Gerd Moellmann committed
129 130 131 132


   Unibyte text.

133 134 135 136 137
   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
138 139 140 141

   Font selection.

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

144 145 146 147 148 149
   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
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165

   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.

166
   2. Setting face-font-family-alternatives allows the user to
Gerd Moellmann's avatar
Gerd Moellmann committed
167 168 169
   specify alternative font families to try if a family specified by a
   face doesn't exist.

170 171 172 173 174 175 176
   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
177

Stefan Monnier's avatar
Typos.  
Stefan Monnier committed
178
   Character composition.
179 180 181 182 183 184 185 186

   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
187

188

Gerd Moellmann's avatar
Gerd Moellmann committed
189 190 191 192 193 194 195
   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.  */

196
#include <config.h>
Kenichi Handa's avatar
Kenichi Handa committed
197
#include <stdio.h>
Jim Blandy's avatar
Jim Blandy committed
198 199
#include <sys/types.h>
#include <sys/stat.h>
200
#include <stdio.h>              /* This needs to be before termchar.h */
201

Jim Blandy's avatar
Jim Blandy committed
202
#include "lisp.h"
203
#include "character.h"
Karl Heuer's avatar
Karl Heuer committed
204
#include "charset.h"
205
#include "keyboard.h"
206
#include "frame.h"
207
#include "termhooks.h"
208

209 210
#ifdef HAVE_WINDOW_SYSTEM
#include "fontset.h"
211 212
#endif /* HAVE_WINDOW_SYSTEM */

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

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

225 226 227 228 229
#ifdef WINDOWSNT
#include "w32term.h"
#include "fontset.h"
/* Redefine X specifics to W32 equivalents to avoid cluttering the
   code with #ifdef blocks. */
230
#undef FRAME_X_DISPLAY_INFO
231 232 233 234 235 236
#define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
#define x_display_info w32_display_info
#define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
#define check_x check_w32
#define x_list_fonts w32_list_fonts
#define GCGraphicsExposures 0
237
#endif /* WINDOWSNT */
238

239
#ifdef MAC_OS
240 241 242
#include "macterm.h"
#define x_display_info mac_display_info
#define check_x check_mac
243
#endif /* MAC_OS */
244

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

Kenichi Handa's avatar
Kenichi Handa committed
252 253 254 255
#ifdef HAVE_WINDOW_SYSTEM
#include "font.h"
#endif	/* HAVE_WINDOW_SYSTEM */

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__
Gerd Moellmann's avatar
Gerd Moellmann committed
269 270 271
#else /* not XOS_NEEDS_TIME_H */
#include <X11/Xos.h>
#endif /* not XOS_NEEDS_TIME_H */
272

Gerd Moellmann's avatar
Gerd Moellmann committed
273
#endif /* HAVE_X_WINDOWS */
274

Gerd Moellmann's avatar
Gerd Moellmann committed
275
#include <ctype.h>
Jim Blandy's avatar
Jim Blandy committed
276

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

#define PT_PER_INCH 72.27

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

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

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

#define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), Qignore_defface)

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

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

293
/* Make a copy of string S on the stack using alloca.  Value is a pointer
Gerd Moellmann's avatar
Gerd Moellmann committed
294 295 296
   to the copy.  */

#define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
297

Gerd Moellmann's avatar
Gerd Moellmann committed
298 299 300
/* Make a copy of the contents of Lisp string S on the stack using
   alloca.  Value is a pointer to the copy.  */

301
#define LSTRDUPA(S) STRDUPA (SDATA ((S)))
Gerd Moellmann's avatar
Gerd Moellmann committed
302

303
/* Size of hash table of realized faces in face caches (should be a
Gerd Moellmann's avatar
Gerd Moellmann committed
304 305 306 307 308 309 310 311 312 313
   prime number).  */

#define FACE_CACHE_BUCKETS_SIZE 1001

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

Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
Lisp_Object QCinverse_video, QCforeground, QCbackground, QCstipple;
Lisp_Object QCwidth, QCfont, QCbold, QCitalic;
Lisp_Object QCreverse_video;
Miles Bader's avatar
Miles Bader committed
314
Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
Kenichi Handa's avatar
Kenichi Handa committed
315
Lisp_Object QCfontset;
Gerd Moellmann's avatar
Gerd Moellmann committed
316 317 318 319 320 321 322 323 324 325 326

/* Symbols used for attribute values.  */

Lisp_Object Qnormal, Qbold, Qultra_light, Qextra_light, Qlight;
Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
Lisp_Object Qoblique, Qitalic, Qreverse_oblique, Qreverse_italic;
Lisp_Object Qultra_condensed, Qextra_condensed, Qcondensed;
Lisp_Object Qsemi_condensed, Qsemi_expanded, Qexpanded, Qextra_expanded;
Lisp_Object Qultra_expanded;
Lisp_Object Qreleased_button, Qpressed_button;
Lisp_Object QCstyle, QCcolor, QCline_width;
327
Lisp_Object Qunspecified;
328
Lisp_Object Qignore_defface;
329 330

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

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

335
Lisp_Object Qframe_set_background_mode;
336

Gerd Moellmann's avatar
Gerd Moellmann committed
337 338
/* Names of basic faces.  */

339
Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
340
Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
341
Lisp_Object Qmode_line_inactive, Qvertical_border;
342
extern Lisp_Object Qmode_line;
343

344 345 346 347 348 349
/* 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.  */

Lisp_Object Qface_alias;

350 351
extern Lisp_Object Qcircular_list;

Gerd Moellmann's avatar
Gerd Moellmann committed
352 353 354 355 356 357 358 359 360 361 362 363 364
/* Default stipple pattern used on monochrome displays.  This stipple
   pattern is used on monochrome displays instead of shades of gray
   for a face background color.  See `set-face-stipple' for possible
   values for this variable.  */

Lisp_Object Vface_default_stipple;

/* 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;

365 366 367 368 369 370
/* 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
371 372 373 374 375 376
/* 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.  */

377
Lisp_Object Vscalable_fonts_allowed, Qscalable_fonts_allowed;
Gerd Moellmann's avatar
Gerd Moellmann committed
378

379 380 381 382
/* List of regular expressions that matches names of fonts to ignore. */

Lisp_Object Vface_ignored_fonts;

383 384 385 386
/* Alist of font name patterns vs the rescaling factor.  */

Lisp_Object Vface_font_rescale_alist;

Gerd Moellmann's avatar
Gerd Moellmann committed
387 388 389 390 391 392
/* Maximum number of fonts to consider in font_list.  If not an
   integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead.  */

Lisp_Object Vfont_list_limit;
#define DEFAULT_FONT_LIST_LIMIT 100

Gerd Moellmann's avatar
Gerd Moellmann committed
393 394 395 396 397 398 399
/* 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
400

401
Lisp_Object Qface;
Gerd Moellmann's avatar
Gerd Moellmann committed
402 403
extern Lisp_Object Qmouse_face;

Kim F. Storm's avatar
Kim F. Storm committed
404 405 406 407
/* Property for basic faces which other faces cannot inherit.  */

Lisp_Object Qface_no_inherit;

Gerd Moellmann's avatar
Gerd Moellmann committed
408 409
/* Error symbol for wrong_type_argument in load_pixmap.  */

410
Lisp_Object Qbitmap_spec_p;
Jim Blandy's avatar
Jim Blandy committed
411

Gerd Moellmann's avatar
Gerd Moellmann committed
412 413 414 415
/* Alist of global face definitions.  Each element is of the form
   (FACE . LFACE) where FACE is a symbol naming a face and LFACE
   is a Lisp vector of face attributes.  These faces are used
   to initialize faces for new frames.  */
416

Gerd Moellmann's avatar
Gerd Moellmann committed
417
Lisp_Object Vface_new_frame_defaults;
418

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

Gerd Moellmann's avatar
Gerd Moellmann committed
421
static int next_lface_id;
Jim Blandy's avatar
Jim Blandy committed
422

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

Gerd Moellmann's avatar
Gerd Moellmann committed
425 426
static Lisp_Object *lface_id_to_name;
static int lface_id_to_name_size;
Jim Blandy's avatar
Jim Blandy committed
427

428 429
/* TTY color-related functions (defined in tty-colors.el).  */

430
Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
Gerd Moellmann's avatar
Gerd Moellmann committed
431

432 433 434 435 436 437 438 439
/* The name of the function used to compute colors on TTYs.  */

Lisp_Object Qtty_color_alist;

/* An alist of defined terminal colors and their RGB values.  */

Lisp_Object Vtty_defined_color_alist;

Gerd Moellmann's avatar
Gerd Moellmann committed
440 441 442 443 444 445 446 447 448 449 450 451 452
/* 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;

453 454 455 456 457 458 459
/* 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.  */

int tty_suppress_bold_inverse_default_colors_p;

460 461 462 463 464
/* 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
465 466 467 468 469 470 471 472
/* The total number of colors currently allocated.  */

#if GLYPH_DEBUG
static int ncolors_allocated;
static int npixmaps_allocated;
static int ngcs;
#endif

473 474 475 476
/* Non-zero means the definition of the `menu' face for new frames has
   been changed.  */

int menu_face_changed_default;
Gerd Moellmann's avatar
Gerd Moellmann committed
477 478 479 480 481 482


/* Function prototypes.  */

struct font_name;
struct table_entry;
483
struct named_merge_point;
Gerd Moellmann's avatar
Gerd Moellmann committed
484

485 486
static void map_tty_color P_ ((struct frame *, struct face *,
			       enum lface_attribute_index, int *));
487
static Lisp_Object resolve_face_name P_ ((Lisp_Object, int));
488
static int may_use_scalable_font_p P_ ((const char *));
Gerd Moellmann's avatar
Gerd Moellmann committed
489 490
static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
491
			      int, int));
Gerd Moellmann's avatar
Gerd Moellmann committed
492
static int x_face_list_fonts P_ ((struct frame *, char *,
493
				  struct font_name **, int, int));
Gerd Moellmann's avatar
Gerd Moellmann committed
494
static int font_scalable_p P_ ((struct font_name *));
495
static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
Gerd Moellmann's avatar
Gerd Moellmann committed
496 497 498
static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
static unsigned char *xstrlwr P_ ((unsigned char *));
static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
Kenichi Handa's avatar
Kenichi Handa committed
499
static void load_face_font P_ ((struct frame *, struct face *));
Gerd Moellmann's avatar
Gerd Moellmann committed
500 501 502 503 504 505 506 507
static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
static void free_face_colors P_ ((struct frame *, struct face *));
static int face_color_gray_p P_ ((struct frame *, char *));
static char *build_font_name P_ ((struct font_name *));
static void free_font_names P_ ((struct font_name *, int));
static int sorted_font_list P_ ((struct frame *, char *,
				 int (*cmpfn) P_ ((const void *, const void *)),
				 struct font_name **));
508 509
static int font_list_1 P_ ((struct frame *, Lisp_Object, Lisp_Object,
			    Lisp_Object, struct font_name **));
510 511
static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object,
			  Lisp_Object, struct font_name **));
Kenichi Handa's avatar
Kenichi Handa committed
512
static int try_font_list P_ ((struct frame *, Lisp_Object,
513
			      Lisp_Object, Lisp_Object, struct font_name **));
514 515
static int try_alternative_families P_ ((struct frame *f, Lisp_Object,
					 Lisp_Object, struct font_name **));
Gerd Moellmann's avatar
Gerd Moellmann committed
516
static int cmp_font_names P_ ((const void *, const void *));
Kenichi Handa's avatar
Kenichi Handa committed
517 518 519 520 521 522
static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *,
				      int));
static struct face *realize_non_ascii_face P_ ((struct frame *, int,
						struct face *));
static struct face *realize_x_face P_ ((struct face_cache *, Lisp_Object *));
static struct face *realize_tty_face P_ ((struct face_cache *, Lisp_Object *));
Gerd Moellmann's avatar
Gerd Moellmann committed
523 524 525 526 527 528 529 530 531 532 533 534 535 536
static int realize_basic_faces P_ ((struct frame *));
static int realize_default_face P_ ((struct frame *));
static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
static int lface_fully_specified_p P_ ((Lisp_Object *));
static int lface_equal_p P_ ((Lisp_Object *, Lisp_Object *));
static unsigned hash_string_case_insensitive P_ ((Lisp_Object));
static unsigned lface_hash P_ ((Lisp_Object *));
static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *));
static struct face_cache *make_face_cache P_ ((struct frame *));
static void clear_face_gcs P_ ((struct face_cache *));
static void free_face_cache P_ ((struct face_cache *));
static int face_numeric_weight P_ ((Lisp_Object));
static int face_numeric_slant P_ ((Lisp_Object));
static int face_numeric_swidth P_ ((Lisp_Object));
537
static int face_fontset P_ ((Lisp_Object *));
538 539 540 541
static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*,
				    struct named_merge_point *));
static int merge_face_ref P_ ((struct frame *, Lisp_Object, Lisp_Object *,
			       int, struct named_merge_point *));
542 543
static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object,
					 Lisp_Object, int, int));
544 545
static void set_lface_from_font_and_fontset P_ ((struct frame *, Lisp_Object,
						 Lisp_Object, int, int));
Gerd Moellmann's avatar
Gerd Moellmann committed
546
static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
547
static struct face *make_realized_face P_ ((Lisp_Object *));
Gerd Moellmann's avatar
Gerd Moellmann committed
548
static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
549
				     struct font_name *, int, int, int *));
Gerd Moellmann's avatar
Gerd Moellmann committed
550 551 552 553 554 555 556 557 558 559 560 561
static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
static void uncache_face P_ ((struct face_cache *, struct face *));
static int xlfd_numeric_slant P_ ((struct font_name *));
static int xlfd_numeric_weight P_ ((struct font_name *));
static int xlfd_numeric_swidth P_ ((struct font_name *));
static Lisp_Object xlfd_symbolic_slant P_ ((struct font_name *));
static Lisp_Object xlfd_symbolic_weight P_ ((struct font_name *));
static Lisp_Object xlfd_symbolic_swidth P_ ((struct font_name *));
static int xlfd_fixed_p P_ ((struct font_name *));
static int xlfd_numeric_value P_ ((struct table_entry *, int, struct font_name *,
				   int, int));
static Lisp_Object xlfd_symbolic_value P_ ((struct table_entry *, int,
562 563
					    struct font_name *, int,
					    Lisp_Object));
Gerd Moellmann's avatar
Gerd Moellmann committed
564 565 566
static struct table_entry *xlfd_lookup_field_contents P_ ((struct table_entry *, int,
							   struct font_name *, int));

567
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
568 569 570 571 572 573 574

static int split_font_name P_ ((struct frame *, struct font_name *, int));
static int xlfd_point_size P_ ((struct frame *, struct font_name *));
static void sort_fonts P_ ((struct frame *, struct font_name *, int,
			       int (*cmpfn) P_ ((const void *, const void *))));
static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
static void x_free_gc P_ ((struct frame *, GC));
575
static void clear_font_table P_ ((struct x_display_info *));
Gerd Moellmann's avatar
Gerd Moellmann committed
576

577 578 579 580
#ifdef WINDOWSNT
extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
#endif /* WINDOWSNT */

581 582
#ifdef USE_X_TOOLKIT
static void x_update_menu_appearance P_ ((struct frame *));
Pavel Janík's avatar
Pavel Janík committed
583 584

extern void free_frame_menubar P_ ((struct frame *));
585 586
#endif /* USE_X_TOOLKIT */

587
#endif /* HAVE_WINDOW_SYSTEM */
Jim Blandy's avatar
Jim Blandy committed
588

589

Gerd Moellmann's avatar
Gerd Moellmann committed
590 591 592
/***********************************************************************
			      Utilities
 ***********************************************************************/
Jim Blandy's avatar
Jim Blandy committed
593

Morten Welinder's avatar
Morten Welinder committed
594
#ifdef HAVE_X_WINDOWS
595

596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647
#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
register_color (pixel)
     unsigned long pixel;
{
  xassert (pixel < 256);
  ++color_count[pixel];
}


/* Register color PIXEL as deallocated.  */

void
unregister_color (pixel)
     unsigned long pixel;
{
  xassert (pixel < 256);
  if (color_count[pixel] > 0)
    --color_count[pixel];
  else
    abort ();
}


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

void
unregister_colors (pixels, n)
     unsigned long *pixels;
     int n;
{
  int i;
  for (i = 0; i < n; ++i)
    unregister_color (pixels[i]);
}

648 649

DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
650 651
       doc: /* Dump currently allocated colors to stderr.  */)
     ()
652 653 654 655
{
  int i, n;

  fputc ('\n', stderr);
656

657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672
  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;
}

673 674
#endif /* DEBUG_X_COLORS */

675

676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691
/* 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
x_free_colors (f, pixels, npixels)
     struct frame *f;
     unsigned long *pixels;
     int npixels;
{
  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)
    {
692
#ifdef DEBUG_X_COLORS
693
      unregister_colors (pixels, npixels);
694
#endif
695 696
      XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
		   pixels, npixels, 0);
697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719
    }
}


/* 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
x_free_dpy_colors (dpy, screen, cmap, pixels, npixels)
     Display *dpy;
     Screen *screen;
     Colormap cmap;
     unsigned long *pixels;
     int npixels;
{
  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)
    {
720
#ifdef DEBUG_X_COLORS
721
      unregister_colors (pixels, npixels);
722
#endif
723
      XFreeColors (dpy, cmap, pixels, npixels, 0);
724 725 726
    }
}

727

Gerd Moellmann's avatar
Gerd Moellmann committed
728 729 730 731 732
/* Create and return a GC for use on frame F.  GC values and mask
   are given by XGCV and MASK.  */

static INLINE GC
x_create_gc (f, mask, xgcv)
733
     struct frame *f;
Gerd Moellmann's avatar
Gerd Moellmann committed
734 735
     unsigned long mask;
     XGCValues *xgcv;
Jim Blandy's avatar
Jim Blandy committed
736 737
{
  GC gc;
Gerd Moellmann's avatar
Gerd Moellmann committed
738 739 740 741 742 743
  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
744

745

Gerd Moellmann's avatar
Gerd Moellmann committed
746 747 748 749 750 751 752
/* Free GC which was used on frame F.  */

static INLINE void
x_free_gc (f, gc)
     struct frame *f;
     GC gc;
{
753
  eassert (interrupt_input_blocked);
754
  IF_DEBUG (xassert (--ngcs >= 0));
Gerd Moellmann's avatar
Gerd Moellmann committed
755 756
  XFreeGC (FRAME_X_DISPLAY (f), gc);
}
757

Gerd Moellmann's avatar
Gerd Moellmann committed
758
#endif /* HAVE_X_WINDOWS */
759

760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784
#ifdef WINDOWSNT
/* W32 emulation of GCs */

static INLINE GC
x_create_gc (f, mask, xgcv)
     struct frame *f;
     unsigned long mask;
     XGCValues *xgcv;
{
  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.  */

static INLINE void
x_free_gc (f, gc)
     struct frame *f;
     GC gc;
{
785
  IF_DEBUG (xassert (--ngcs >= 0));
786 787 788 789
  xfree (gc);
}

#endif  /* WINDOWSNT */
790

791 792 793 794 795 796 797 798 799 800
#ifdef MAC_OS
/* Mac OS emulation of GCs */

static INLINE GC
x_create_gc (f, mask, xgcv)
     struct frame *f;
     unsigned long mask;
     XGCValues *xgcv;
{
  GC gc;
801
  BLOCK_INPUT;
802
  gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
803 804
  UNBLOCK_INPUT;
  IF_DEBUG (++ngcs);
805 806 807 808 809 810 811 812
  return gc;
}

static INLINE void
x_free_gc (f, gc)
     struct frame *f;
     GC gc;
{
813
  eassert (interrupt_input_blocked);
814
  IF_DEBUG (xassert (--ngcs >= 0));
815 816 817 818 819
  XFreeGC (FRAME_MAC_DISPLAY (f), gc);
}

#endif  /* MAC_OS */

Gerd Moellmann's avatar
Gerd Moellmann committed
820 821 822 823 824
/* Like stricmp.  Used to compare parts of font names which are in
   ISO8859-1.  */

int
xstricmp (s1, s2)
825
     const unsigned char *s1, *s2;
Gerd Moellmann's avatar
Gerd Moellmann committed
826 827
{
  while (*s1 && *s2)
828
    {
Gerd Moellmann's avatar
Gerd Moellmann committed
829 830 831 832 833
      unsigned char c1 = tolower (*s1);
      unsigned char c2 = tolower (*s2);
      if (c1 != c2)
	return c1 < c2 ? -1 : 1;
      ++s1, ++s2;
834
    }
835

Gerd Moellmann's avatar
Gerd Moellmann committed
836 837 838 839
  if (*s1 == 0)
    return *s2 == 0 ? 0 : -1;
  return 1;
}
840 841


Gerd Moellmann's avatar
Gerd Moellmann committed
842
/* Like strlwr, which might not always be available.  */
843

Gerd Moellmann's avatar
Gerd Moellmann committed
844 845 846 847 848 849 850
static unsigned char *
xstrlwr (s)
     unsigned char *s;
{
  unsigned char *p = s;

  for (p = s; *p; ++p)
851 852 853 854
    /* On Mac OS X 10.3, tolower also converts non-ASCII characters
       for some locales.  */
    if (isascii (*p))
      *p = tolower (*p);
Gerd Moellmann's avatar
Gerd Moellmann committed
855 856

  return s;
Jim Blandy's avatar
Jim Blandy committed
857
}
858

859

860 861 862 863 864
/* 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
865 866 867 868 869 870 871

static INLINE struct frame *
frame_or_selected_frame (frame, nparam)
     Lisp_Object frame;
     int nparam;
{
  if (NILP (frame))
872
    frame = selected_frame;
873

874
  CHECK_LIVE_FRAME (frame);
875
  return XFRAME (frame);
876
}
Gerd Moellmann's avatar
Gerd Moellmann committed
877

878

Gerd Moellmann's avatar
Gerd Moellmann committed
879 880 881
/***********************************************************************
			   Frames and faces
 ***********************************************************************/
882

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

Gerd Moellmann's avatar
Gerd Moellmann committed
885 886
void
init_frame_faces (f)
887 888
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
889 890 891
  /* Make a face cache, if F doesn't have one.  */
  if (FRAME_FACE_CACHE (f) == NULL)
    FRAME_FACE_CACHE (f) = make_face_cache (f);
892

893
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
894
  /* Make the image cache.  */
895
  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
896 897 898 899 900
    {
      if (FRAME_X_IMAGE_CACHE (f) == NULL)
	FRAME_X_IMAGE_CACHE (f) = make_image_cache ();
      ++FRAME_X_IMAGE_CACHE (f)->refcount;
    }
901
#endif /* HAVE_WINDOW_SYSTEM */
902

903
  /* Realize basic faces.  Must have enough information in frame
Gerd Moellmann's avatar
Gerd Moellmann committed
904 905 906
     parameters to realize basic faces at this point.  */
#ifdef HAVE_X_WINDOWS
  if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
907 908 909
#endif
#ifdef WINDOWSNT
  if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
Andrew Choi's avatar
Andrew Choi committed
910 911 912
#endif
#ifdef MAC_OS
  if (!FRAME_MAC_P (f) || FRAME_MAC_WINDOW (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
913 914 915 916
#endif
    if (!realize_basic_faces (f))
      abort ();
}
917 918


Gerd Moellmann's avatar
Gerd Moellmann committed
919
/* Free face cache of frame F.  Called from Fdelete_frame.  */
920

Gerd Moellmann's avatar
Gerd Moellmann committed
921 922
void
free_frame_faces (f)
923 924
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
925
  struct face_cache *face_cache = FRAME_FACE_CACHE (f);
926

Gerd Moellmann's avatar
Gerd Moellmann committed
927 928 929 930 931
  if (face_cache)
    {
      free_face_cache (face_cache);
      FRAME_FACE_CACHE (f) = NULL;
    }
932

933 934
#ifdef HAVE_WINDOW_SYSTEM
  if (FRAME_WINDOW_P (f))
935
    {
Gerd Moellmann's avatar
Gerd Moellmann committed
936 937
      struct image_cache *image_cache = FRAME_X_IMAGE_CACHE (f);
      if (image_cache)
938
	{
Gerd Moellmann's avatar
Gerd Moellmann committed
939 940 941
	  --image_cache->refcount;
	  if (image_cache->refcount == 0)
	    free_image_cache (f);
942 943
	}
    }
944
#endif /* HAVE_WINDOW_SYSTEM */
945 946
}

Gerd Moellmann's avatar
Gerd Moellmann committed
947

948 949 950 951
/* 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
952 953 954

void
recompute_basic_faces (f)
955 956
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
957 958
  if (FRAME_FACE_CACHE (f))
    {
959
      clear_face_cache (0);
960 961
      if (!realize_basic_faces (f))
	abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
962 963
    }
}
964 965


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

969
void
Gerd Moellmann's avatar
Gerd Moellmann committed
970 971
clear_face_cache (clear_fonts_p)
     int clear_fonts_p;
972
{
973
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
974 975
  Lisp_Object tail, frame;
  struct frame *f;
976

Gerd Moellmann's avatar
Gerd Moellmann committed
977 978
  if (clear_fonts_p
      || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
979
    {
980
      struct x_display_info *dpyinfo;
981

Kenichi Handa's avatar
Kenichi Handa committed
982 983 984
#ifdef USE_FONT_BACKEND
      if (! enable_font_backend)
#endif	/* USE_FONT_BACKEND */
985 986 987 988 989
      /* Fonts are common for frames on one display, i.e. on
	 one X screen.  */
      for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
	if (dpyinfo->n_fonts > CLEAR_FONT_TABLE_NFONTS)
	  clear_font_table (dpyinfo);
990

Gerd Moellmann's avatar
Gerd Moellmann committed
991 992 993 994
      /* 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;
995

Gerd Moellmann's avatar
Gerd Moellmann committed
996
      FOR_EACH_FRAME (tail, frame)
997
	{
998
	  struct frame *f = XFRAME (frame);
999
	  if (FRAME_WINDOW_P (f)
Gerd Moellmann's avatar
Gerd Moellmann committed
1000
	      && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
1001
	    free_all_realized_faces (frame);
Gerd Moellmann's avatar
Gerd Moellmann committed
1002 1003 1004 1005 1006 1007 1008 1009
	}
    }
  else
    {
      /* Clear GCs of realized faces.  */
      FOR_EACH_FRAME (tail, frame)
	{
	  f = XFRAME (frame);
1010
	  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
1011 1012 1013
	    {
	      clear_face_gcs (FRAME_FACE_CACHE (f));
	      clear_image_cache (f, 0);
1014 1015
	    }
	}
1016
    }
1017
#endif /* HAVE_WINDOW_SYSTEM */
1018 1019
}

Gerd Moellmann's avatar
Gerd Moellmann committed
1020 1021

DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
1022 1023 1024
       doc: /* Clear face caches on all frames.
Optional THOROUGHLY non-nil means try to free unused fonts, too.  */)
     (thoroughly)
1025
     Lisp_Object thoroughly;
1026
{
1027
  clear_face_cache (!NILP (thoroughly));
1028 1029
  ++face_change_count;
  ++windows_or_buffers_changed;
Gerd Moellmann's avatar
Gerd Moellmann committed
1030 1031 1032 1033 1034
  return Qnil;
}



1035
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
1036 1037


Gerd Moellmann's avatar
Gerd Moellmann committed
1038 1039
/* Remove fonts from the font table of DPYINFO except for the default
   ASCII fonts of frames on that display.  Called from clear_face_cache
1040
   from time to time.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
1041 1042

static void
1043 1044
clear_font_table (dpyinfo)
     struct x_display_info *dpyinfo;
Gerd Moellmann's avatar
Gerd Moellmann committed
1045 1046 1047
{
  int i;

1048
  /* Free those fonts that are not used by frames on DPYINFO.  */
1049 1050 1051
  for (i = 0; i < dpyinfo->n_fonts; ++i)
    {
      struct font_info *font_info = dpyinfo->font_table + i;
1052 1053 1054 1055 1056 1057
      Lisp_Object tail, frame;

      /* Check if slot is already free.  */
      if (font_info->name == NULL)
	continue;

1058
      /* Don't free a default font of some frame.  */
1059 1060 1061 1062 1063 1064 1065
      FOR_EACH_FRAME (tail, frame)
	{
	  struct frame *f = XFRAME (frame);
	  if (FRAME_WINDOW_P (f)
	      && font_info->font == FRAME_FONT (f))
	    break;
	}
Gerd Moellmann's avatar
Gerd Moellmann committed
1066

1067
      if (!NILP (tail))
1068
	continue;
Gerd Moellmann's avatar
Gerd Moellmann committed
1069

1070 1071 1072 1073
      /* Free names.  */
      if (font_info->full_name != font_info->name)
	xfree (font_info->full_name);
      xfree (font_info->name);
Gerd Moellmann's avatar
Gerd Moellmann committed
1074

1075 1076
      /* Free the font.  */
      BLOCK_INPUT;
1077
#ifdef HAVE_X_WINDOWS
1078
      XFreeFont (dpyinfo->display, font_info->font);
1079 1080
#endif
#ifdef WINDOWSNT
1081
      w32_unload_font (dpyinfo, font_info->font);
1082 1083 1084
#endif
#ifdef MAC_OS
      mac_unload_font (dpyinfo, font_info->font);
Jason Rumney's avatar