xfaces.c 204 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, 2009 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

Kenichi Handa's avatar
Kenichi Handa committed
30 31 32
   2. Font foundary name.

   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
69
   specified, the correspoinding 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
#include <setjmp.h>
208

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

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

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

228 229 230 231 232
#ifdef WINDOWSNT
#include "w32term.h"
#include "fontset.h"
/* Redefine X specifics to W32 equivalents to avoid cluttering the
   code with #ifdef blocks. */
233
#undef FRAME_X_DISPLAY_INFO
234 235 236 237 238
#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 GCGraphicsExposures 0
239
#endif /* WINDOWSNT */
240

241 242 243 244 245 246 247 248 249 250
#ifdef HAVE_NS
#include "nsterm.h"
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
#define x_display_info ns_display_info
#define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
#define check_x check_ns
#define GCGraphicsExposures 0
#endif /* HAVE_NS */

Jim Blandy's avatar
Jim Blandy committed
251
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
252
#include "dispextern.h"
Jim Blandy's avatar
Jim Blandy committed
253
#include "blockinput.h"
254
#include "window.h"
Karl Heuer's avatar
Karl Heuer committed
255
#include "intervals.h"
256
#include "termchar.h"
Jim Blandy's avatar
Jim Blandy committed
257

Kenichi Handa's avatar
Kenichi Handa committed
258
#include "font.h"
259
#ifdef HAVE_WINDOW_SYSTEM
260 261
#include "fontset.h"
#endif /* HAVE_WINDOW_SYSTEM */
Kenichi Handa's avatar
Kenichi Handa committed
262

Morten Welinder's avatar
Morten Welinder committed
263
#ifdef HAVE_X_WINDOWS
Gerd Moellmann's avatar
Gerd Moellmann committed
264 265

/* Compensate for a bug in Xos.h on some systems, on which it requires
266 267 268 269
   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
270
#ifdef XOS_NEEDS_TIME_H
271
#include <time.h>
272 273 274
#undef USG
#include <X11/Xos.h>
#define USG
275
#define __TIMEVAL__
Gerd Moellmann's avatar
Gerd Moellmann committed
276 277 278
#else /* not XOS_NEEDS_TIME_H */
#include <X11/Xos.h>
#endif /* not XOS_NEEDS_TIME_H */
279

Gerd Moellmann's avatar
Gerd Moellmann committed
280
#endif /* HAVE_X_WINDOWS */
281

Gerd Moellmann's avatar
Gerd Moellmann committed
282
#include <ctype.h>
Jim Blandy's avatar
Jim Blandy committed
283

Gerd Moellmann's avatar
Gerd Moellmann committed
284 285 286 287
/* Number of pt per inch (from the TeXbook).  */

#define PT_PER_INCH 72.27

Gerd Moellmann's avatar
Gerd Moellmann committed
288 289 290 291
/* Non-zero if face attribute ATTR is unspecified.  */

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

292 293 294 295
/* 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
296 297 298 299
/* Value is the number of elements of VECTOR.  */

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

300
/* Make a copy of string S on the stack using alloca.  Value is a pointer
Gerd Moellmann's avatar
Gerd Moellmann committed
301 302 303
   to the copy.  */

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

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

308
#define LSTRDUPA(S) STRDUPA (SDATA ((S)))
Gerd Moellmann's avatar
Gerd Moellmann committed
309

310
/* Size of hash table of realized faces in face caches (should be a
Gerd Moellmann's avatar
Gerd Moellmann committed
311 312 313 314 315 316 317 318 319 320
   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
321
Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
Kenichi Handa's avatar
Kenichi Handa committed
322
Lisp_Object QCfontset;
Gerd Moellmann's avatar
Gerd Moellmann committed
323

324 325 326 327 328
/* Keywords symbols used for font properties.  */
extern Lisp_Object QCfoundry, QCadstyle, QCregistry;
extern Lisp_Object QCspacing, QCsize, QCavgwidth;
extern Lisp_Object Qp;

Gerd Moellmann's avatar
Gerd Moellmann committed
329 330 331 332 333 334 335 336 337 338
/* 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;
339
Lisp_Object Qunspecified;
340
Lisp_Object Qignore_defface;
341 342

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

344
/* The name of the function to call when the background of the frame
345
   has changed, frame_set_background_mode.  */
346

347
Lisp_Object Qframe_set_background_mode;
348

Gerd Moellmann's avatar
Gerd Moellmann committed
349 350
/* Names of basic faces.  */

351
Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
352
Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
353
Lisp_Object Qmode_line_inactive, Qvertical_border;
354
extern Lisp_Object Qmode_line;
355

356 357 358 359 360 361
/* 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;

362 363
extern Lisp_Object Qcircular_list;

Gerd Moellmann's avatar
Gerd Moellmann committed
364 365 366 367 368 369 370 371 372 373 374 375 376
/* 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;

377 378 379 380 381 382
/* 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
383 384 385 386 387 388
/* 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.  */

389
Lisp_Object Vscalable_fonts_allowed, Qscalable_fonts_allowed;
Gerd Moellmann's avatar
Gerd Moellmann committed
390

391 392 393 394
/* List of regular expressions that matches names of fonts to ignore. */

Lisp_Object Vface_ignored_fonts;

395 396 397 398
/* Alist of font name patterns vs the rescaling factor.  */

Lisp_Object Vface_font_rescale_alist;

Gerd Moellmann's avatar
Gerd Moellmann committed
399 400 401 402 403 404
/* 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
405 406 407 408 409 410 411
/* 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
412

413
Lisp_Object Qface;
Gerd Moellmann's avatar
Gerd Moellmann committed
414 415
extern Lisp_Object Qmouse_face;

Kim F. Storm's avatar
Kim F. Storm committed
416 417 418 419
/* Property for basic faces which other faces cannot inherit.  */

Lisp_Object Qface_no_inherit;

Gerd Moellmann's avatar
Gerd Moellmann committed
420 421
/* Error symbol for wrong_type_argument in load_pixmap.  */

422
Lisp_Object Qbitmap_spec_p;
Jim Blandy's avatar
Jim Blandy committed
423

Gerd Moellmann's avatar
Gerd Moellmann committed
424 425 426 427
/* 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.  */
428

Gerd Moellmann's avatar
Gerd Moellmann committed
429
Lisp_Object Vface_new_frame_defaults;
430

431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447
/* Alist of face remappings.  Each element is of the form:
   (FACE REPLACEMENT...) which causes display of the face FACE to use
   REPLACEMENT... instead.  REPLACEMENT... is interpreted the same way
   the value of a `face' text property is: it may be (1) A face name,
   (2) A list of face names, (3) A property-list of face attribute/value
   pairs, or (4) A list of face names intermixed with lists containing
   face attribute/value pairs.

   Multiple entries in REPLACEMENT... are merged together to form the final
   result, with faces or attributes earlier in the list taking precedence
   over those that are later.

   Face-name remapping cycles are suppressed; recursive references use
   the underlying face instead of the remapped face.  */

Lisp_Object Vface_remapping_alist;

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

Gerd Moellmann's avatar
Gerd Moellmann committed
450
static int next_lface_id;
Jim Blandy's avatar
Jim Blandy committed
451

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

Gerd Moellmann's avatar
Gerd Moellmann committed
454 455
static Lisp_Object *lface_id_to_name;
static int lface_id_to_name_size;
Jim Blandy's avatar
Jim Blandy committed
456

457 458
/* TTY color-related functions (defined in tty-colors.el).  */

459
Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
Gerd Moellmann's avatar
Gerd Moellmann committed
460

461 462 463 464 465 466 467 468
/* 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
469 470 471 472 473 474 475 476 477 478 479 480 481
/* 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;

482 483 484 485 486 487 488
/* 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;

489 490 491 492 493
/* 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
494 495 496 497 498 499 500 501
/* The total number of colors currently allocated.  */

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

502 503 504 505
/* 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
506 507 508 509 510


/* Function prototypes.  */

struct table_entry;
511
struct named_merge_point;
Gerd Moellmann's avatar
Gerd Moellmann committed
512

513 514
static void map_tty_color P_ ((struct frame *, struct face *,
			       enum lface_attribute_index, int *));
515
static Lisp_Object resolve_face_name P_ ((Lisp_Object, int));
516
static int may_use_scalable_font_p P_ ((const char *));
Gerd Moellmann's avatar
Gerd Moellmann committed
517
static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
518 519
static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *,
				     int, struct named_merge_point *));
Gerd Moellmann's avatar
Gerd Moellmann committed
520 521 522 523 524
static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
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 *));
Kenichi Handa's avatar
Kenichi Handa committed
525 526
static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *,
				      int));
527
static struct face *realize_non_ascii_face P_ ((struct frame *, Lisp_Object,
Kenichi Handa's avatar
Kenichi Handa committed
528 529 530
						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
531 532 533 534 535 536 537 538 539 540 541
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 *));
542
static int face_fontset P_ ((Lisp_Object *));
543 544 545 546
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 *));
547 548
static int set_lface_from_font P_ ((struct frame *, Lisp_Object, Lisp_Object,
				    int));
Gerd Moellmann's avatar
Gerd Moellmann committed
549
static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
550
static struct face *make_realized_face P_ ((Lisp_Object *));
Gerd Moellmann's avatar
Gerd Moellmann committed
551 552 553
static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
static void uncache_face P_ ((struct face_cache *, struct face *));

554
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
555 556 557 558

static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
static void x_free_gc P_ ((struct frame *, GC));

559 560
#ifdef USE_X_TOOLKIT
static void x_update_menu_appearance P_ ((struct frame *));
Pavel Janík's avatar
Pavel Janík committed
561 562

extern void free_frame_menubar P_ ((struct frame *));
563 564
#endif /* USE_X_TOOLKIT */

565
#endif /* HAVE_WINDOW_SYSTEM */
Jim Blandy's avatar
Jim Blandy committed
566

567

Gerd Moellmann's avatar
Gerd Moellmann committed
568 569 570
/***********************************************************************
			      Utilities
 ***********************************************************************/
Jim Blandy's avatar
Jim Blandy committed
571

Morten Welinder's avatar
Morten Welinder committed
572
#ifdef HAVE_X_WINDOWS
573

574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 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
#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]);
}

626 627

DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
628 629
       doc: /* Dump currently allocated colors to stderr.  */)
     ()
630 631 632 633
{
  int i, n;

  fputc ('\n', stderr);
634

635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650
  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;
}

651 652
#endif /* DEBUG_X_COLORS */

653

654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669
/* 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)
    {
670
#ifdef DEBUG_X_COLORS
671
      unregister_colors (pixels, npixels);
672
#endif
673 674
      XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
		   pixels, npixels, 0);
675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697
    }
}


/* 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)
    {
698
#ifdef DEBUG_X_COLORS
699
      unregister_colors (pixels, npixels);
700
#endif
701
      XFreeColors (dpy, cmap, pixels, npixels, 0);
702 703 704
    }
}

705

Gerd Moellmann's avatar
Gerd Moellmann committed
706 707 708 709 710
/* 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)
711
     struct frame *f;
Gerd Moellmann's avatar
Gerd Moellmann committed
712 713
     unsigned long mask;
     XGCValues *xgcv;
Jim Blandy's avatar
Jim Blandy committed
714 715
{
  GC gc;
Gerd Moellmann's avatar
Gerd Moellmann committed
716 717 718 719 720 721
  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
722

723

Gerd Moellmann's avatar
Gerd Moellmann committed
724 725 726 727 728 729 730
/* Free GC which was used on frame F.  */

static INLINE void
x_free_gc (f, gc)
     struct frame *f;
     GC gc;
{
731
  eassert (interrupt_input_blocked);
732
  IF_DEBUG (xassert (--ngcs >= 0));
Gerd Moellmann's avatar
Gerd Moellmann committed
733 734
  XFreeGC (FRAME_X_DISPLAY (f), gc);
}
735

Gerd Moellmann's avatar
Gerd Moellmann committed
736
#endif /* HAVE_X_WINDOWS */
737

738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762
#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;
{
763
  IF_DEBUG (xassert (--ngcs >= 0));
764 765 766 767
  xfree (gc);
}

#endif  /* WINDOWSNT */
768

769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788
#ifdef HAVE_NS
/* NS emulation of GCs */

static INLINE GC
x_create_gc (f, mask, xgcv)
     struct frame *f;
     unsigned long mask;
     XGCValues *xgcv;
{
  GC gc = xmalloc (sizeof (*gc));
  if (gc)
      bcopy(xgcv, gc, sizeof(XGCValues));
  return gc;
}

static INLINE void
x_free_gc (f, gc)
     struct frame *f;
     GC gc;
{
789
  xfree (gc);
790 791 792
}
#endif  /* HAVE_NS */

793 794
/* Like strcasecmp/stricmp.  Used to compare parts of font names which
   are in ISO8859-1.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
795 796

int
797
xstrcasecmp (s1, s2)
798
     const unsigned char *s1, *s2;
Gerd Moellmann's avatar
Gerd Moellmann committed
799 800
{
  while (*s1 && *s2)
801
    {
Gerd Moellmann's avatar
Gerd Moellmann committed
802 803 804 805 806
      unsigned char c1 = tolower (*s1);
      unsigned char c2 = tolower (*s2);
      if (c1 != c2)
	return c1 < c2 ? -1 : 1;
      ++s1, ++s2;
807
    }
808

Gerd Moellmann's avatar
Gerd Moellmann committed
809 810 811 812
  if (*s1 == 0)
    return *s2 == 0 ? 0 : -1;
  return 1;
}
813 814


815 816 817 818 819
/* 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
820 821 822 823 824 825 826

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

829
  CHECK_LIVE_FRAME (frame);
830
  return XFRAME (frame);
831
}
Gerd Moellmann's avatar
Gerd Moellmann committed
832

833

Gerd Moellmann's avatar
Gerd Moellmann committed
834 835 836
/***********************************************************************
			   Frames and faces
 ***********************************************************************/
837

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

Gerd Moellmann's avatar
Gerd Moellmann committed
840 841
void
init_frame_faces (f)
842 843
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
844 845 846
  /* Make a face cache, if F doesn't have one.  */
  if (FRAME_FACE_CACHE (f) == NULL)
    FRAME_FACE_CACHE (f) = make_face_cache (f);
847

848
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
849
  /* Make the image cache.  */
850
  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
851
    {
Chong Yidong's avatar
Chong Yidong committed
852 853 854
      /* 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.  */
855 856 857
      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
858
    }
859
#endif /* HAVE_WINDOW_SYSTEM */
860

861
  /* Realize basic faces.  Must have enough information in frame
Gerd Moellmann's avatar
Gerd Moellmann committed
862 863 864
     parameters to realize basic faces at this point.  */
#ifdef HAVE_X_WINDOWS
  if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
865 866 867
#endif
#ifdef WINDOWSNT
  if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
Andrew Choi's avatar
Andrew Choi committed
868
#endif
869 870
#ifdef HAVE_NS
  if (!FRAME_NS_P (f) || FRAME_NS_WINDOW (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
871 872
#endif
    if (!realize_basic_faces (f))
873
        abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
874
}
875 876


877
/* Free face cache of frame F.  Called from delete_frame.  */
878

Gerd Moellmann's avatar
Gerd Moellmann committed
879 880
void
free_frame_faces (f)
881 882
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
883
  struct face_cache *face_cache = FRAME_FACE_CACHE (f);
884

Gerd Moellmann's avatar
Gerd Moellmann committed
885 886 887 888 889
  if (face_cache)
    {
      free_face_cache (face_cache);
      FRAME_FACE_CACHE (f) = NULL;
    }
890

891 892
#ifdef HAVE_WINDOW_SYSTEM
  if (FRAME_WINDOW_P (f))
893
    {
894
      struct image_cache *image_cache = FRAME_IMAGE_CACHE (f);
Gerd Moellmann's avatar
Gerd Moellmann committed
895
      if (image_cache)
896
	{
Gerd Moellmann's avatar
Gerd Moellmann committed
897 898 899
	  --image_cache->refcount;
	  if (image_cache->refcount == 0)
	    free_image_cache (f);
900 901
	}
    }
902
#endif /* HAVE_WINDOW_SYSTEM */
903 904
}

Gerd Moellmann's avatar
Gerd Moellmann committed
905

906 907 908 909
/* 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
910 911 912

void
recompute_basic_faces (f)
913 914
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
915 916
  if (FRAME_FACE_CACHE (f))
    {
917
      clear_face_cache (0);
918 919
      if (!realize_basic_faces (f))
	abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
920 921
    }
}
922 923


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

927
void
Gerd Moellmann's avatar
Gerd Moellmann committed
928 929
clear_face_cache (clear_fonts_p)
     int clear_fonts_p;
930
{
931
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
932 933
  Lisp_Object tail, frame;
  struct frame *f;
934

Gerd Moellmann's avatar
Gerd Moellmann committed
935 936
  if (clear_fonts_p
      || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
937
    {
938 939 940 941 942
#if 0
      /* Not yet implemented.  */
      clear_font_cache (frame);
#endif

Gerd Moellmann's avatar
Gerd Moellmann committed
943 944 945 946
      /* 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;
947

Gerd Moellmann's avatar
Gerd Moellmann committed
948
      FOR_EACH_FRAME (tail, frame)
949
	{
950
	  struct frame *f = XFRAME (frame);
951
	  if (FRAME_WINDOW_P (f)
Gerd Moellmann's avatar
Gerd Moellmann committed
952
	      && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
953
	    free_all_realized_faces (frame);
Gerd Moellmann's avatar
Gerd Moellmann committed
954 955 956 957 958 959 960 961
	}
    }
  else
    {
      /* Clear GCs of realized faces.  */
      FOR_EACH_FRAME (tail, frame)
	{
	  f = XFRAME (frame);
962
	  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
963
	      clear_face_gcs (FRAME_FACE_CACHE (f));
964
	}
965
      clear_image_caches (Qnil);
966
    }
967
#endif /* HAVE_WINDOW_SYSTEM */
968 969
}

Gerd Moellmann's avatar
Gerd Moellmann committed
970 971

DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
972 973 974
       doc: /* Clear face caches on all frames.
Optional THOROUGHLY non-nil means try to free unused fonts, too.  */)
     (thoroughly)
975
     Lisp_Object thoroughly;
976
{
977
  clear_face_cache (!NILP (thoroughly));
978 979
  ++face_change_count;
  ++windows_or_buffers_changed;
Gerd Moellmann's avatar
Gerd Moellmann committed
980 981 982 983 984 985 986 987
  return Qnil;
}

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

988
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
989

990
DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
991
       doc: /* Value is non-nil if OBJECT is a valid bitmap specification.
Gerd Moellmann's avatar
Gerd Moellmann committed
992 993 994 995
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
996 997
\(WIDTH + 7)/8 bytes.  */)
     (object)
Gerd Moellmann's avatar
Gerd Moellmann committed
998 999
     Lisp_Object object;
{
1000
  int pixmap_p = 0;
1001

1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012
  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
	 HEIGHT must be integers > 0, and DATA must be string large
	 enough to hold a bitmap of the specified size.  */
      Lisp_Object width, height, data;

      height = width = data = Qnil;
1013

1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025
      if (CONSP (object))
	{
	  width = XCAR (object);
	  object = XCDR (object);
	  if (CONSP (object))
	    {
	      height = XCAR (object);
	      object = XCDR (object);
	      if (CONSP (object))
		data = XCAR (object);
	    }
	}
1026

1027 1028 1029 1030
      if (NATNUMP (width) && NATNUMP (height) && STRINGP (data))
	{
	  int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
			       / BITS_PER_CHAR);
1031
	  if (SBYTES (data) >= bytes_per_row * XINT (height))
1032 1033 1034 1035 1036
	    pixmap_p = 1;
	}
    }

  return pixmap_p ? Qt : Qnil;
1037 1038 1039
}


Gerd Moellmann's avatar
Gerd Moellmann committed
1040 1041 1042 1043 1044 1045
/* 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.  */
1046

Gerd Moellmann's avatar
Gerd Moellmann committed
1047
static int
1048
load_pixmap (f, name, w_ptr, h_ptr)
1049
     FRAME_PTR f;
1050 1051 1052 1053 1054 1055
     Lisp_Object name;
     unsigned int *w_ptr, *h_ptr;
{
  int bitmap_id;

  if (NILP (name))
Gerd Moellmann's avatar
Gerd Moellmann committed
1056
    return 0;
1057

Kim F. Storm's avatar
Kim F. Storm committed
1058
  CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name);
1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071

  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)));

1072
      bitmap_id = x_create_bitmap_from_data (f, SDATA (bits),
1073 1074 1075 1076 1077 1078 1079 1080 1081
					     w, h);
    }
  else
    {
      /* It must be a string -- a file name.  */
      bitmap_id = x_create_bitmap_from_file (f, name);
    }
  UNBLOCK_INPUT;

1082
  if (bitmap_id <