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 Free Software Foundation.
Jim Blandy's avatar
Jim Blandy committed
3

Jim Blandy's avatar
Jim Blandy committed
4 5 6 7
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
Jim Blandy's avatar
Jim Blandy committed
8
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
9 10 11 12 13 14 15 16 17
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
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
20

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

29
   1. Font family name.
30

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

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

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

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

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

Gerd Moellmann's avatar
Gerd Moellmann committed
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
   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.

58 59 60 61 62 63 64 65 66 67
   14. Font or fontset pattern, or nil.  This is a special attribute.
   When this attribyte is specified, the face uses a font opened by
   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
68 69
   15. A face name or list of face names from which to inherit attributes.

Gerd Moellmann's avatar
Gerd Moellmann committed
70 71 72 73
   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
74 75
   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
76 77 78 79

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

Gerd Moellmann's avatar
Gerd Moellmann committed
81
   A face doesn't have to specify all attributes.  Those not specified
82 83
   have a value of `unspecified'.  Faces specifying all attributes but
   the 14th are called `fully-specified'.
Gerd Moellmann's avatar
Gerd Moellmann committed
84 85 86 87 88 89 90 91 92 93 94 95 96


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

Gerd Moellmann's avatar
Gerd Moellmann committed
98 99 100 101 102 103 104
   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.

105 106 107 108
   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
109 110
   them.

111 112 113 114 115 116 117 118 119 120 121
   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.

   Thus, all realzied face have a realized fontset.
Gerd Moellmann's avatar
Gerd Moellmann committed
122 123 124 125


   Unibyte text.

126 127 128 129 130
   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
131 132 133 134

   Font selection.

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

137 138 139 140 141 142
   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
143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158

   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.

159
   2. Setting face-font-family-alternatives allows the user to
Gerd Moellmann's avatar
Gerd Moellmann committed
160 161 162
   specify alternative font families to try if a family specified by a
   face doesn't exist.

163 164 165 166 167 168 169
   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
170

171
   Character compositition.
172 173 174 175 176 177 178 179

   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
180

181

Gerd Moellmann's avatar
Gerd Moellmann committed
182 183 184 185 186 187 188
   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.  */

189
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
190 191 192
#include <sys/types.h>
#include <sys/stat.h>
#include "lisp.h"
Karl Heuer's avatar
Karl Heuer committed
193
#include "charset.h"
194 195
#include "frame.h"

196 197
#ifdef HAVE_WINDOW_SYSTEM
#include "fontset.h"
198 199
#endif /* HAVE_WINDOW_SYSTEM */

Morten Welinder's avatar
Morten Welinder committed
200
#ifdef HAVE_X_WINDOWS
Jim Blandy's avatar
Jim Blandy committed
201
#include "xterm.h"
202 203 204 205
#ifdef USE_MOTIF
#include <Xm/Xm.h>
#include <Xm/XmStrDefs.h>
#endif /* USE_MOTIF */
206
#endif /* HAVE_X_WINDOWS */
Gerd Moellmann's avatar
Gerd Moellmann committed
207

Morten Welinder's avatar
Morten Welinder committed
208 209 210
#ifdef MSDOS
#include "dosfns.h"
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
211

212 213 214 215 216 217 218 219 220 221 222 223 224 225
#ifdef WINDOWSNT
#include "w32term.h"
#include "fontset.h"
/* Redefine X specifics to W32 equivalents to avoid cluttering the
   code with #ifdef blocks. */
#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
/* For historic reasons, FONT_WIDTH refers to average width on W32,
   not maximum as on X. Redefine here. */
#define FONT_WIDTH FONT_MAX_WIDTH
226
#endif /* WINDOWSNT */
227

228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254
#ifdef macintosh
#include "macterm.h"
#define x_display_info mac_display_info
#define check_x check_mac

extern XGCValues *XCreateGC (void *, WindowPtr, unsigned long, XGCValues *);

static INLINE GC
x_create_gc (f, mask, xgcv)
     struct frame *f;
     unsigned long mask;
     XGCValues *xgcv;
{
  GC gc;
  gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
  return gc;
}

static INLINE void
x_free_gc (f, gc)
     struct frame *f;
     GC gc;
{
  XFreeGC (FRAME_MAC_DISPLAY (f), gc);
}
#endif

Jim Blandy's avatar
Jim Blandy committed
255
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
256
#include "dispextern.h"
Jim Blandy's avatar
Jim Blandy committed
257
#include "blockinput.h"
258
#include "window.h"
Karl Heuer's avatar
Karl Heuer committed
259
#include "intervals.h"
Jim Blandy's avatar
Jim Blandy committed
260

Morten Welinder's avatar
Morten Welinder committed
261
#ifdef HAVE_X_WINDOWS
Gerd Moellmann's avatar
Gerd Moellmann committed
262 263

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

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

Gerd Moellmann's avatar
Gerd Moellmann committed
280 281 282
#include <stdio.h>
#include <ctype.h>
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
283

Gerd Moellmann's avatar
Gerd Moellmann committed
284 285 286 287
#ifndef max
#define max(A, B)	((A) > (B) ? (A) : (B))
#define min(A, B)	((A) < (B) ? (A) : (B))
#define abs(X)		((X) < 0 ? -(X) : (X))
288
#endif
289

Gerd Moellmann's avatar
Gerd Moellmann committed
290 291 292 293
/* Number of pt per inch (from the TeXbook).  */

#define PT_PER_INCH 72.27

Gerd Moellmann's avatar
Gerd Moellmann committed
294 295 296 297 298 299 300 301
/* Non-zero if face attribute ATTR is unspecified.  */

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

/* Value is the number of elements of VECTOR.  */

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

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

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

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

#define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)

312
/* Size of hash table of realized faces in face caches (should be a
Gerd Moellmann's avatar
Gerd Moellmann committed
313 314 315 316
   prime number).  */

#define FACE_CACHE_BUCKETS_SIZE 1001

317
/* A definition of XColor for non-X frames.  */
318

319
#ifndef HAVE_X_WINDOWS
320 321 322

typedef struct
{
323 324 325 326
  unsigned long pixel;
  unsigned short red, green, blue;
  char flags;
  char pad;
327 328 329 330
}
XColor;

#endif /* not HAVE_X_WINDOWS */
331

Gerd Moellmann's avatar
Gerd Moellmann committed
332 333 334 335 336 337
/* 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
338
Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
Gerd Moellmann's avatar
Gerd Moellmann committed
339 340 341 342 343 344 345 346 347 348 349

/* 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;
350 351 352
Lisp_Object Qunspecified;

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

354 355 356 357 358
/* The name of the function to call when the background of the frame
   has changed, frame_update_face_colors.  */

Lisp_Object Qframe_update_face_colors;

Gerd Moellmann's avatar
Gerd Moellmann committed
359 360
/* Names of basic faces.  */

361
Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
362
Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
363
extern Lisp_Object Qmode_line;
364

365 366 367 368 369 370
/* 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;

371 372 373 374
/* Names of frame parameters related to faces.  */

extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
extern Lisp_Object Qborder_color, Qcursor_color, Qmouse_color;
Gerd Moellmann's avatar
Gerd Moellmann committed
375 376 377 378 379 380 381 382 383 384 385 386 387 388

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

389 390 391 392 393 394
/* 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
395 396 397 398 399 400 401 402
/* 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.  */

Lisp_Object Vscalable_fonts_allowed;

403 404 405 406
/* List of regular expressions that matches names of fonts to ignore. */

Lisp_Object Vface_ignored_fonts;

Gerd Moellmann's avatar
Gerd Moellmann committed
407 408 409 410 411 412
/* 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
413 414 415 416 417 418 419
/* 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
420

421
Lisp_Object Qface;
Gerd Moellmann's avatar
Gerd Moellmann committed
422 423 424 425
extern Lisp_Object Qmouse_face;

/* Error symbol for wrong_type_argument in load_pixmap.  */

426
Lisp_Object Qbitmap_spec_p;
Jim Blandy's avatar
Jim Blandy committed
427

Gerd Moellmann's avatar
Gerd Moellmann committed
428 429 430 431
/* 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.  */
432

Gerd Moellmann's avatar
Gerd Moellmann committed
433
Lisp_Object Vface_new_frame_defaults;
434

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

Gerd Moellmann's avatar
Gerd Moellmann committed
437
static int next_lface_id;
Jim Blandy's avatar
Jim Blandy committed
438

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

Gerd Moellmann's avatar
Gerd Moellmann committed
441 442
static Lisp_Object *lface_id_to_name;
static int lface_id_to_name_size;
Jim Blandy's avatar
Jim Blandy committed
443

444 445
/* TTY color-related functions (defined in tty-colors.el).  */

446
Lisp_Object Qtty_color_desc, Qtty_color_by_index;
Gerd Moellmann's avatar
Gerd Moellmann committed
447

448 449 450 451 452 453 454 455
/* 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
456 457 458 459 460 461 462 463 464 465 466 467 468
/* 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;

469 470 471 472
/* Incremented for every change in the `menu' face.  */

int menu_face_change_count;

473 474 475 476 477 478 479
/* 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;

480 481 482 483 484
/* 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
485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
/* The total number of colors currently allocated.  */

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



/* Function prototypes.  */

struct font_name;
struct table_entry;

500 501
static void map_tty_color P_ ((struct frame *, struct face *,
			       enum lface_attribute_index, int *));
502
static Lisp_Object resolve_face_name P_ ((Lisp_Object));
Gerd Moellmann's avatar
Gerd Moellmann committed
503 504 505 506 507 508 509 510 511 512 513 514 515 516
static int may_use_scalable_font_p P_ ((struct font_name *, char *));
static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
			      int));
static int first_font_matching P_ ((struct frame *f, char *,
				    struct font_name *));
static int x_face_list_fonts P_ ((struct frame *, char *,
				  struct font_name *, int, int, int));
static int font_scalable_p P_ ((struct font_name *));
static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
static unsigned char *xstrlwr P_ ((unsigned char *));
static void signal_error P_ ((char *, Lisp_Object));
static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
517
static void load_face_font P_ ((struct frame *, struct face *, int));
Gerd Moellmann's avatar
Gerd Moellmann committed
518 519 520 521 522 523 524 525
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 **));
526 527
static int font_list_1 P_ ((struct frame *, Lisp_Object, Lisp_Object,
			    Lisp_Object, struct font_name **));
528 529 530 531
static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object,
			  Lisp_Object, struct font_name **));
static int try_font_list P_ ((struct frame *, Lisp_Object *, Lisp_Object,
			      Lisp_Object, Lisp_Object, struct font_name **));
Gerd Moellmann's avatar
Gerd Moellmann committed
532
static int cmp_font_names P_ ((const void *, const void *));
533 534
static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, int,
				      struct face *, int));
Gerd Moellmann's avatar
Gerd Moellmann committed
535
static struct face *realize_x_face P_ ((struct face_cache *,
536
					Lisp_Object *, int, struct face *));
Gerd Moellmann's avatar
Gerd Moellmann committed
537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553
static struct face *realize_tty_face P_ ((struct face_cache *,
					  Lisp_Object *, int));
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 free_realized_face P_ ((struct frame *, struct face *));
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));
554 555
static int face_fontset P_ ((Lisp_Object *));
static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int));
Miles Bader's avatar
Miles Bader committed
556 557 558
static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, Lisp_Object));
static void merge_face_inheritance P_ ((struct frame *f, Lisp_Object,
					Lisp_Object *, Lisp_Object));
Gerd Moellmann's avatar
Gerd Moellmann committed
559 560
static void merge_face_vector_with_property P_ ((struct frame *, Lisp_Object *,
						 Lisp_Object));
561 562
static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object,
					 Lisp_Object, int, int));
Gerd Moellmann's avatar
Gerd Moellmann committed
563
static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
564
static struct face *make_realized_face P_ ((Lisp_Object *));
Gerd Moellmann's avatar
Gerd Moellmann committed
565 566 567 568 569 570 571 572 573 574 575 576 577 578 579
static void free_realized_faces P_ ((struct face_cache *));
static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
				     struct font_name *, int));
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,
580 581
					    struct font_name *, int,
					    Lisp_Object));
Gerd Moellmann's avatar
Gerd Moellmann committed
582 583 584
static struct table_entry *xlfd_lookup_field_contents P_ ((struct table_entry *, int,
							   struct font_name *, int));

585
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
586 587 588 589 590 591 592 593 594

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));
static void clear_font_table P_ ((struct frame *));

595 596 597 598 599
#ifdef WINDOWSNT
extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
#endif /* WINDOWSNT */

#endif /* HAVE_WINDOW_SYSTEM */
Jim Blandy's avatar
Jim Blandy committed
600

601

Gerd Moellmann's avatar
Gerd Moellmann committed
602 603 604
/***********************************************************************
			      Utilities
 ***********************************************************************/
Jim Blandy's avatar
Jim Blandy committed
605

Morten Welinder's avatar
Morten Welinder committed
606
#ifdef HAVE_X_WINDOWS
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 648 649 650 651 652 653 654 655 656 657 658 659
#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]);
}

660 661 662 663 664 665 666 667

DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
  "Dump currently allocated colors and their reference counts to stderr.")
  ()
{
  int i, n;

  fputc ('\n', stderr);
668

669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
  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;
}

685 686
#endif /* DEBUG_X_COLORS */

687

688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703
/* 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)
    {
704 705
      XFreeColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
		   pixels, npixels, 0);
706
#ifdef DEBUG_X_COLORS
707
      unregister_colors (pixels, npixels);
708
#endif
709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732
    }
}


/* 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)
    {
      XFreeColors (dpy, cmap, pixels, npixels, 0);
733
#ifdef DEBUG_X_COLORS
734
      unregister_colors (pixels, npixels);
735
#endif
736 737 738
    }
}

739

Gerd Moellmann's avatar
Gerd Moellmann committed
740 741 742 743 744
/* 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)
745
     struct frame *f;
Gerd Moellmann's avatar
Gerd Moellmann committed
746 747
     unsigned long mask;
     XGCValues *xgcv;
Jim Blandy's avatar
Jim Blandy committed
748 749
{
  GC gc;
Gerd Moellmann's avatar
Gerd Moellmann committed
750 751 752 753 754 755
  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
756

757

Gerd Moellmann's avatar
Gerd Moellmann committed
758 759 760 761 762 763 764
/* Free GC which was used on frame F.  */

static INLINE void
x_free_gc (f, gc)
     struct frame *f;
     GC gc;
{
765
  BLOCK_INPUT;
Gerd Moellmann's avatar
Gerd Moellmann committed
766 767 768 769
  xassert (--ngcs >= 0);
  XFreeGC (FRAME_X_DISPLAY (f), gc);
  UNBLOCK_INPUT;
}
770

Gerd Moellmann's avatar
Gerd Moellmann committed
771
#endif /* HAVE_X_WINDOWS */
772

773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804
#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;
{
  BLOCK_INPUT;
  xassert (--ngcs >= 0);
  xfree (gc);
  UNBLOCK_INPUT;
}

#endif  /* WINDOWSNT */
805

Gerd Moellmann's avatar
Gerd Moellmann committed
806 807 808 809 810 811 812 813
/* Like stricmp.  Used to compare parts of font names which are in
   ISO8859-1.  */

int
xstricmp (s1, s2)
     unsigned char *s1, *s2;
{
  while (*s1 && *s2)
814
    {
Gerd Moellmann's avatar
Gerd Moellmann committed
815 816 817 818 819
      unsigned char c1 = tolower (*s1);
      unsigned char c2 = tolower (*s2);
      if (c1 != c2)
	return c1 < c2 ? -1 : 1;
      ++s1, ++s2;
820
    }
821

Gerd Moellmann's avatar
Gerd Moellmann committed
822 823 824 825
  if (*s1 == 0)
    return *s2 == 0 ? 0 : -1;
  return 1;
}
826 827


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

Gerd Moellmann's avatar
Gerd Moellmann committed
830 831 832 833 834 835 836 837 838 839
static unsigned char *
xstrlwr (s)
     unsigned char *s;
{
  unsigned char *p = s;

  for (p = s; *p; ++p)
    *p = tolower (*p);

  return s;
Jim Blandy's avatar
Jim Blandy committed
840
}
841

842

Gerd Moellmann's avatar
Gerd Moellmann committed
843 844 845 846 847 848
/* Signal `error' with message S, and additional argument ARG.  */

static void
signal_error (s, arg)
     char *s;
     Lisp_Object arg;
849
{
Gerd Moellmann's avatar
Gerd Moellmann committed
850 851
  Fsignal (Qerror, Fcons (build_string (s), Fcons (arg, Qnil)));
}
852

Gerd Moellmann's avatar
Gerd Moellmann committed
853

854 855 856 857 858
/* 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
859 860 861 862 863 864 865

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

868 869
  CHECK_LIVE_FRAME (frame, nparam);
  return XFRAME (frame);
870
}
Gerd Moellmann's avatar
Gerd Moellmann committed
871

872

Gerd Moellmann's avatar
Gerd Moellmann committed
873 874 875
/***********************************************************************
			   Frames and faces
 ***********************************************************************/
876

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

Gerd Moellmann's avatar
Gerd Moellmann committed
879 880
void
init_frame_faces (f)
881 882
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
883 884 885
  /* Make a face cache, if F doesn't have one.  */
  if (FRAME_FACE_CACHE (f) == NULL)
    FRAME_FACE_CACHE (f) = make_face_cache (f);
886

887
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
888
  /* Make the image cache.  */
889
  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
890 891 892 893 894
    {
      if (FRAME_X_IMAGE_CACHE (f) == NULL)
	FRAME_X_IMAGE_CACHE (f) = make_image_cache ();
      ++FRAME_X_IMAGE_CACHE (f)->refcount;
    }
895
#endif /* HAVE_WINDOW_SYSTEM */
896

897
  /* Realize basic faces.  Must have enough information in frame
Gerd Moellmann's avatar
Gerd Moellmann committed
898 899 900
     parameters to realize basic faces at this point.  */
#ifdef HAVE_X_WINDOWS
  if (!FRAME_X_P (f) || FRAME_X_WINDOW (f))
901 902 903
#endif
#ifdef WINDOWSNT
  if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
904 905 906 907
#endif
    if (!realize_basic_faces (f))
      abort ();
}
908 909


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

Gerd Moellmann's avatar
Gerd Moellmann committed
912 913
void
free_frame_faces (f)
914 915
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
916
  struct face_cache *face_cache = FRAME_FACE_CACHE (f);
917

Gerd Moellmann's avatar
Gerd Moellmann committed
918 919 920 921 922
  if (face_cache)
    {
      free_face_cache (face_cache);
      FRAME_FACE_CACHE (f) = NULL;
    }
923

924 925
#ifdef HAVE_WINDOW_SYSTEM
  if (FRAME_WINDOW_P (f))
926
    {
Gerd Moellmann's avatar
Gerd Moellmann committed
927 928
      struct image_cache *image_cache = FRAME_X_IMAGE_CACHE (f);
      if (image_cache)
929
	{
Gerd Moellmann's avatar
Gerd Moellmann committed
930 931 932
	  --image_cache->refcount;
	  if (image_cache->refcount == 0)
	    free_image_cache (f);
933 934
	}
    }
935
#endif /* HAVE_WINDOW_SYSTEM */
936 937
}

Gerd Moellmann's avatar
Gerd Moellmann committed
938

939 940 941 942
/* 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
943 944 945

void
recompute_basic_faces (f)
946 947
     struct frame *f;
{
Gerd Moellmann's avatar
Gerd Moellmann committed
948 949
  if (FRAME_FACE_CACHE (f))
    {
950
      clear_face_cache (0);
951 952
      if (!realize_basic_faces (f))
	abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
953 954
    }
}
955 956


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

960
void
Gerd Moellmann's avatar
Gerd Moellmann committed
961 962
clear_face_cache (clear_fonts_p)
     int clear_fonts_p;
963
{
964
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
965 966
  Lisp_Object tail, frame;
  struct frame *f;
967

Gerd Moellmann's avatar
Gerd Moellmann committed
968 969
  if (clear_fonts_p
      || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
970
    {
Gerd Moellmann's avatar
Gerd Moellmann committed
971 972 973 974
      /* 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;
975

Gerd Moellmann's avatar
Gerd Moellmann committed
976
      FOR_EACH_FRAME (tail, frame)
977
	{
Gerd Moellmann's avatar
Gerd Moellmann committed
978
	  f = XFRAME (frame);
979
	  if (FRAME_WINDOW_P (f)
Gerd Moellmann's avatar
Gerd Moellmann committed
980
	      && FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
981
	    {
Gerd Moellmann's avatar
Gerd Moellmann committed
982 983 984 985 986 987 988 989 990 991 992
	      free_all_realized_faces (frame);
	      clear_font_table (f);
	    }
	}
    }
  else
    {
      /* Clear GCs of realized faces.  */
      FOR_EACH_FRAME (tail, frame)
	{
	  f = XFRAME (frame);
993
	  if (FRAME_WINDOW_P (f))
Gerd Moellmann's avatar
Gerd Moellmann committed
994 995 996
	    {
	      clear_face_gcs (FRAME_FACE_CACHE (f));
	      clear_image_cache (f, 0);
997 998
	    }
	}
999
    }
1000
#endif /* HAVE_WINDOW_SYSTEM */
1001 1002
}

Gerd Moellmann's avatar
Gerd Moellmann committed
1003 1004 1005 1006 1007 1008

DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
  "Clear face caches on all frames.\n\
Optional THOROUGHLY non-nil means try to free unused fonts, too.")
  (thorougly)
     Lisp_Object thorougly;
1009
{
Gerd Moellmann's avatar
Gerd Moellmann committed
1010
  clear_face_cache (!NILP (thorougly));
1011 1012
  ++face_change_count;
  ++windows_or_buffers_changed;
Gerd Moellmann's avatar
Gerd Moellmann committed
1013 1014 1015 1016 1017
  return Qnil;
}



1018
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
1019 1020


1021 1022 1023
/* Remove those fonts from the font table of frame F exept for the
   default ASCII font for the frame.  Called from clear_face_cache
   from time to time.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
1024 1025 1026 1027 1028 1029 1030 1031

static void
clear_font_table (f)
     struct frame *f;
{
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
  int i;

1032
  xassert (FRAME_WINDOW_P (f));
Gerd Moellmann's avatar
Gerd Moellmann committed
1033

1034 1035 1036 1037
  /* Free those fonts that are not used by the frame F as the default.  */
  for (i = 0; i < dpyinfo->n_fonts; ++i)
    {
      struct font_info *font_info = dpyinfo->font_table + i;
Gerd Moellmann's avatar
Gerd Moellmann committed
1038

1039 1040 1041
      if (!font_info->name
	  || font_info->font == FRAME_FONT (f))
	continue;
Gerd Moellmann's avatar
Gerd Moellmann committed
1042

1043 1044 1045 1046
      /* 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
1047

1048 1049
      /* Free the font.  */
      BLOCK_INPUT;
1050
#ifdef HAVE_X_WINDOWS
1051
      XFreeFont (dpyinfo->display, font_info->font);
1052 1053
#endif
#ifdef WINDOWSNT
1054
      w32_unload_font (dpyinfo, font_info->font);
1055
#endif
1056
      UNBLOCK_INPUT;
Gerd Moellmann's avatar
Gerd Moellmann committed
1057

1058 1059 1060 1061
      /* Mark font table slot free.  */
      font_info->font = NULL;
      font_info->name = font_info->full_name = NULL;
    }
Gerd Moellmann's avatar
Gerd Moellmann committed
1062 1063
}

1064
#endif /* HAVE_WINDOW_SYSTEM */
Gerd Moellmann's avatar
Gerd Moellmann committed
1065 1066 1067 1068 1069 1070 1071


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

1072
#ifdef HAVE_WINDOW_SYSTEM
Gerd Moellmann's avatar
Gerd Moellmann committed
1073

1074 1075 1076 1077
DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
  "Value is non-nil if OBJECT is a valid bitmap specification.\n\
A bitmap specification is either a string, a file name, or a list\n\
(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1078 1079 1080
HEIGHT is its height, and DATA is a string containing the bits of\n\
the pixmap.  Bits are stored row by row, each row occupies\n\
(WIDTH + 7)/8 bytes.")
Gerd Moellmann's avatar
Gerd Moellmann committed
1081 1082 1083
  (object)
     Lisp_Object object;
{
1084
  int pixmap_p = 0;
1085

1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096
  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;
1097

1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109
      if (CONSP (object))
	{
	  width = XCAR (object);
	  object = XCDR (object);
	  if (CONSP (object))
	    {
	      height = XCAR (object);
	      object = XCDR (object);
	      if (CONSP (object))
		data = XCAR (object);
	    }
	}
1110

1111 1112 1113 1114
      if (NATNUMP (width) && NATNUMP (height) && STRINGP (data))
	{
	  int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
			       / BITS_PER_CHAR);
1115
	  if (STRING_BYTES (XSTRING (data)) >= bytes_per_row * XINT (height))
1116 1117 1118 1119 1120
	    pixmap_p = 1;
	}
    }

  return pixmap_p ? Qt : Qnil;
1121 1122 1123
}


Gerd Moellmann's avatar
Gerd Moellmann committed
1124 1125 1126 1127 1128 1129
/* 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.  */
1130

Gerd Moellmann's avatar
Gerd Moellmann committed
1131
static int
1132
load_pixmap (f, name, w_ptr, h_ptr)
1133
     FRAME_PTR f;
1134 1135 1136 1137 1138 1139 1140
     Lisp_Object name;
     unsigned int *w_ptr, *h_ptr;
{
  int bitmap_id;
  Lisp_Object tem;

  if (NILP (name))
Gerd Moellmann's avatar
Gerd Moellmann committed
1141
    return 0;
1142

1143
  tem = Fbitmap_spec_p (name);
1144
  if (NILP (tem))
1145
    wrong_type_argument (Qbitmap_spec_p, name);
1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168

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

      bitmap_id = x_create_bitmap_from_data (f, XSTRING (bits)->data,
					     w, h);
    }
  else
    {
      /* It must be a string -- a file name.  */
      bitmap_id = x_create_bitmap_from_file (f, name);
    }
  UNBLOCK_INPUT;

1169
  if (bitmap_id < 0)
Gerd Moellmann's avatar
Gerd Moellmann committed
1170
    {
1171
      add_to_log ("Invalid or undefined bitmap %s", name, Qnil);
Gerd Moellmann's avatar
Gerd Moellmann committed
1172
      bitmap_id = 0;
1173

Gerd Moellmann's avatar
Gerd Moellmann committed
1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189
      if (w_ptr)
	*w_ptr = 0;
      if (h_ptr)
	*h_ptr = 0;
    }
  else
    {
#if GLYPH_DEBUG
      ++npixmaps_allocated;
#endif
      if (w_ptr)
	*w_ptr = x_bitmap_width (f, bitmap_id);

      if (h_ptr)
	*h_ptr = x_bitmap_height (f, bitmap_id);
    }
1190 1191

  return bitmap_id;
1192
}
Morten Welinder's avatar
Morten Welinder committed
1193

1194
#endif /* HAVE_WINDOW_SYSTEM */
Gerd Moellmann's avatar
Gerd Moellmann committed
1195

Morten Welinder's avatar
Morten Welinder committed
1196

Gerd Moellmann's avatar
Gerd Moellmann committed
1197 1198 1199 1200 1201

/***********************************************************************
			 Minimum font bounds
 ***********************************************************************/