xfaces.c 26.9 KB
Newer Older
1
/* "Face" primitives.
Jim Blandy's avatar
Jim Blandy committed
2
   Copyright (C) 1993 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 18 19
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
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

Jim Blandy's avatar
Jim Blandy committed
20
/* This is derived from work by Lucid (some parts very loosely so).  */
Jim Blandy's avatar
Jim Blandy committed
21

Jim Blandy's avatar
Jim Blandy committed
22 23 24 25 26 27
#include <sys/types.h>
#include <sys/stat.h>

#include "config.h"
#include "lisp.h"

28 29
#ifdef HAVE_X_WINDOWS

Jim Blandy's avatar
Jim Blandy committed
30 31
#include "xterm.h"
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
32
#include "dispextern.h"
Jim Blandy's avatar
Jim Blandy committed
33
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
34
#include "blockinput.h"
35
#include "window.h"
Jim Blandy's avatar
Jim Blandy committed
36 37 38 39

/* Display Context for the icons */ 
#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>
40
/* #include <X11/Xmu/Drawing.h> */  /* Appears not to be used */
Jim Blandy's avatar
Jim Blandy committed
41 42
#include <X11/Xos.h>

43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104

/* An explanation of the face data structures.  */

/* ========================= Face Data Structures =========================

   All lisp code uses symbols as face names.

   Each frame has a face_alist member (with the frame-face-alist and
   set-frame-face-alist accessors), associating the face names with
   vectors of the form 
       [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE-P]
   where
       face is the symbol `face',
       NAME is the symbol with which this vector is associated (a backpointer),
       ID is the face ID, an integer used internally by the C code to identify
           the face,
       FONT, FOREGROUND, and BACKGROUND are strings naming the fonts and colors
           to use with the face,
       BACKGROUND-PIXMAP is the name of an x bitmap filename, which we don't
           use right now, and
       UNDERLINE-P is non-nil if the face should be underlined.
   (lisp/faces.el maintains these association lists.)

   The frames' private alists hold the frame-local definitions for the
   faces.  The lisp variable global-face-data contains the global
   defaults for faces.  (See lisp/faces.el for this too.)

   In the C code, we also have a `struct face' with the elements
      `foreground', `background', `font', and `underline',
   which specify its visual appearance, and elements
      `gc' and `cached_index';
   `gc' may be an X GC which has been built for the given display
   parameters.  Faces with GC's are called `display faces'.  Whether
   or not a face has a GC depends on what data structure the face is
   in; we explain these more below.  (See src/dispextern.h.)

   Each frame also has members called `faces' and `n_faces' (with the
   accessors FRAME_FACES and FRAME_N_FACES), which define an array of
   struct face pointers, indexed by face ID (element 2 of the
   vector).  These are called "frame faces".
      Element 0 is the default face --- the one used for normal text.
      Element 1 is the modeline face.
   These faces have their GC's set; the rest do not.  (See src/xterm.h.)

   The global variables `face_vector' and `nfaces' define another
   array of struct face pointers, with their GC's set.  This array
   acts as a cache of GC's to be used by all frames.  The function
   `intern_face', passed a struct face *, searches face_vector for a
   struct face with the same parameters, adds a new one with a GC if
   it doesn't find one, and returns it.  If you have a `struct face',
   and you want a GC for it, call intern_face on that struct, and it
   will return a `struct face *' with its GC set.  The faces in
   face_vector are called `cached faces.' (See src/xfaces.c.)

   The `GLYPH' data type is an unsigned integer type; the bottom byte
   is a character code, and the byte above that is a face id.  The
   `struct frame_glyphs' structure, used to describe frames' current
   or desired contents, is essentially a matrix of GLYPHs; the face
   ID's in a struct frame_glyphs are indices into FRAME_FACES.  (See
   src/dispextern.h.)

   Some subtleties:
Jim Blandy's avatar
Jim Blandy committed
105
   
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
   Since face_vector is just a cache --- there are no pointers into it
   from the rest of the code, and everyone accesses it through
   intern_face --- we could just free its GC's and throw the whole
   thing away without breaking anything.  This gives us a simple way
   to garbage-collect old GC's nobody's using any more - we can just
   purge face_vector, and then let subsequent calls to intern_face
   refill it as needed.  The function clear_face_vector performs this
   purge.

   We're often applying intern_face to faces in frames' local arrays -
   for example, we do this while sending GLYPHs from a struct
   frame_glyphs to X during redisplay.  It would be nice to avoid
   searching all of face_vector every time we intern a frame's face.
   So, when intern_face finds a match for FACE in face_vector, it
   stores the index of the match in FACE's cached_index member, and
   checks there first next time.  */
   

/* Definitions and declarations.  */

Jim Blandy's avatar
Jim Blandy committed
126 127 128 129 130 131 132 133 134 135
/* A table of display faces.  */
struct face **face_vector;
/* The length in use of the table.  */
int nfaces;
/* The allocated length of the table.   */
int nfaces_allocated;

/* The number of face-id's in use (same for all frames).  */
int next_face_id;

136 137 138
/* The number of the face to use to indicate the region.  */
int region_face;

139 140
/* This is what appears in a slot in a face to signify that the face
   does not specify that display aspect.  */
Jim Blandy's avatar
Jim Blandy committed
141 142
#define FACE_DEFAULT (~0)

Jim Blandy's avatar
Jim Blandy committed
143 144
Lisp_Object Qface, Qwindow, Qpriority;

Jim Blandy's avatar
Jim Blandy committed
145
static void build_face ();
Jim Blandy's avatar
Jim Blandy committed
146
static Lisp_Object face_name_id_number ();
147 148 149

struct face *intern_face ();
static void ensure_face_ready ();
Jim Blandy's avatar
Jim Blandy committed
150

151 152 153 154 155 156 157 158 159 160 161 162 163 164
/* Allocating, copying, and comparing struct faces.  */

/* Allocate a new face */
static struct face *
allocate_face ()
{
  struct face *result = (struct face *) xmalloc (sizeof (struct face));
  bzero (result, sizeof (struct face));
  result->font = (XFontStruct *) FACE_DEFAULT;
  result->foreground = FACE_DEFAULT;
  result->background = FACE_DEFAULT;
  result->stipple = FACE_DEFAULT;
  return result;
}
Jim Blandy's avatar
Jim Blandy committed
165

166
/* Make a new face that's a copy of an existing one.  */
Jim Blandy's avatar
Jim Blandy committed
167 168 169 170 171 172 173 174 175
static struct face *
copy_face (face)
     struct face *face;
{
  struct face *result = allocate_face ();

  result->font = face->font;
  result->foreground = face->foreground;
  result->background = face->background;
Jim Blandy's avatar
Jim Blandy committed
176
  result->stipple = face->stipple;
Jim Blandy's avatar
Jim Blandy committed
177 178 179 180 181 182 183 184 185
  result->underline = face->underline;

  return result;
}

static int
face_eql (face1, face2)
     struct face *face1, *face2;
{
186
  return (   face1->font       == face2->font
Jim Blandy's avatar
Jim Blandy committed
187 188
	  && face1->foreground == face2->foreground
	  && face1->background == face2->background
189 190
	  && face1->stipple    == face2->stipple
	  && face1->underline  == face2->underline);
Jim Blandy's avatar
Jim Blandy committed
191
}
192 193

/* Interning faces in the `face_vector' cache, and clearing that cache.  */
Jim Blandy's avatar
Jim Blandy committed
194 195 196 197 198

/* Return the unique display face corresponding to the user-level face FACE.
   If there isn't one, make one, and find a slot in the face_vector to
   put it in.  */
static struct face *
Jim Blandy's avatar
Jim Blandy committed
199
get_cached_face (f, face)
Jim Blandy's avatar
Jim Blandy committed
200 201 202 203
     struct frame *f;
     struct face *face;
{
  int i, empty = -1;
Jim Blandy's avatar
Jim Blandy committed
204
  struct face *result;
Jim Blandy's avatar
Jim Blandy committed
205

206 207 208 209 210 211 212
  /* Perhaps FACE->cached_index is valid; this could happen if FACE is
     in a frame's face list.  */
  if (face->cached_index >= 0
      && face->cached_index < nfaces
      && face_eql (face_vector[face->cached_index], face))
    return face_vector[face->cached_index];

Jim Blandy's avatar
Jim Blandy committed
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
  /* Look for an existing display face that does the job.
     Also find an empty slot if any.   */
  for (i = 0; i < nfaces; i++)
    {
      if (face_eql (face_vector[i], face))
	return face_vector[i];
      if (face_vector[i] == 0)
	empty = i;
    }

  /* If no empty slots, make one.  */
  if (empty < 0 && nfaces == nfaces_allocated)
    {
      int newsize = nfaces + 20;
      face_vector
	= (struct face **) xrealloc (face_vector,
				     newsize * sizeof (struct face *));
      nfaces_allocated = newsize;
    }

  if (empty < 0)
    empty = nfaces++;

  /* Put a new display face in the empty slot.  */
  result = copy_face (face);
  face_vector[empty] = result;
  
  /* Make a graphics context for it.  */
  build_face (f, result);

  return result;
}

246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
/* Given a frame face, return an equivalent display face
   (one which has a graphics context).  */

struct face *
intern_face (f, face)
     struct frame *f;
     struct face *face;
{
  /* If it's equivalent to the default face, use that.  */
  if (face_eql (face, FRAME_DEFAULT_FACE (f)))
    {
      if (!FRAME_DEFAULT_FACE (f)->gc)
	build_face (f, FRAME_DEFAULT_FACE (f));
      return FRAME_DEFAULT_FACE (f);
    }
  
  /* If it's equivalent to the mode line face, use that.  */
  if (face_eql (face, FRAME_MODE_LINE_FACE (f)))
    {
      if (!FRAME_MODE_LINE_FACE (f)->gc)
	build_face (f, FRAME_MODE_LINE_FACE (f));
      return FRAME_MODE_LINE_FACE (f);
    }

270 271 272 273
  /* If it's not one of the frame's default faces, it shouldn't have a GC.  */
  if (face->gc)
    abort ();
  
274 275 276 277
  /* Get a specialized display face.  */
  return get_cached_face (f, face);
}

Jim Blandy's avatar
Jim Blandy committed
278 279 280 281 282 283 284 285 286 287
/* Clear out face_vector and start anew.
   This should be done from time to time just to avoid
   keeping too many graphics contexts in face_vector
   that are no longer needed.  */

void
clear_face_vector ()
{
  Lisp_Object rest;
  Display *dpy = x_current_display;
Jim Blandy's avatar
Jim Blandy committed
288
  int i;
Jim Blandy's avatar
Jim Blandy committed
289 290 291 292 293 294

  BLOCK_INPUT;
  /* Free the display faces in the face_vector.  */
  for (i = 0; i < nfaces; i++)
    {
      struct face *face = face_vector[i];
Jim Blandy's avatar
Jim Blandy committed
295 296
      if (face->gc)
	XFreeGC (dpy, face->gc);
Jim Blandy's avatar
Jim Blandy committed
297 298 299 300 301 302 303
      xfree (face);
    }
  nfaces = 0;

  UNBLOCK_INPUT;
}

304 305
/* Allocating and freeing X resources for display faces.  */

Jim Blandy's avatar
Jim Blandy committed
306 307
/* Make a graphics context for face FACE, which is on frame F,
   if that can be done.  */
Jim Blandy's avatar
Jim Blandy committed
308 309
static void
build_face (f, face)
310 311
     struct frame *f;
     struct face *face;
Jim Blandy's avatar
Jim Blandy committed
312 313 314 315 316
{
  GC gc;
  XGCValues xgcv;
  unsigned long mask;

Jim Blandy's avatar
Jim Blandy committed
317 318 319 320 321 322 323 324 325 326 327 328
  if (face->foreground != FACE_DEFAULT)
    xgcv.foreground = face->foreground;
  else
    xgcv. foreground = f->display.x->foreground_pixel;
  if (face->background != FACE_DEFAULT)
    xgcv.background = face->background;
  else
    xgcv. background = f->display.x->background_pixel;
  if (face->font && (int) face->font != FACE_DEFAULT)
    xgcv.font = face->font->fid;
  else
    xgcv.font = f->display.x->font->fid;
Jim Blandy's avatar
Jim Blandy committed
329 330 331 332 333
  xgcv.graphics_exposures = 0;
  mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
  gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
		  mask, &xgcv);
#if 0
Jim Blandy's avatar
Jim Blandy committed
334 335
  if (face->stipple && face->stipple != FACE_DEFAULT)
    XSetStipple (x_current_display, gc, face->stipple);
Jim Blandy's avatar
Jim Blandy committed
336
#endif
Jim Blandy's avatar
Jim Blandy committed
337
  face->gc = gc;
Jim Blandy's avatar
Jim Blandy committed
338
}
339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410

/* Allocating, freeing, and duplicating fonts, colors, and pixmaps.  */

static XFontStruct *
load_font (f, name)
     struct frame *f;
     Lisp_Object name;
{
  XFontStruct *font;

  if (NILP (name))
    return (XFontStruct *) FACE_DEFAULT;

  CHECK_STRING (name, 0);
  BLOCK_INPUT;
  font = XLoadQueryFont (x_current_display, (char *) XSTRING (name)->data);
  UNBLOCK_INPUT;

  if (! font)
    Fsignal (Qerror, Fcons (build_string ("undefined font"),
			    Fcons (name, Qnil)));
  return font;
}

static void
unload_font (f, font)
     struct frame *f;
     XFontStruct *font;
{
  if (!font || font == ((XFontStruct *) FACE_DEFAULT))
    return;
  XFreeFont (x_current_display, font);
}

static unsigned long
load_color (f, name)
     struct frame *f;
     Lisp_Object name;
{
  Display *dpy = x_current_display;
  Colormap cmap;
  XColor color;
  int result;

  if (NILP (name))
    return FACE_DEFAULT;

  cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));

  CHECK_STRING (name, 0);
  BLOCK_INPUT;
  result = XParseColor (dpy, cmap, (char *) XSTRING (name)->data, &color);
  UNBLOCK_INPUT;
  if (! result)
    Fsignal (Qerror, Fcons (build_string ("undefined color"),
			    Fcons (name, Qnil)));
  BLOCK_INPUT;
  result = XAllocColor (dpy, cmap, &color);
  UNBLOCK_INPUT;
  if (! result)
    Fsignal (Qerror, Fcons (build_string ("X server cannot allocate color"),
			    Fcons (name, Qnil)));
  return (unsigned long) color.pixel;
}

static void
unload_color (f, pixel)
     struct frame *f;
     Pixel pixel;
{
  Colormap cmap;
  Display *dpy = x_current_display;
411 412 413
  if (pixel == FACE_DEFAULT
      || pixel == BLACK_PIX_DEFAULT
      || pixel == WHITE_PIX_DEFAULT)
414 415 416 417 418 419 420 421 422
    return;
  cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
  BLOCK_INPUT;
  XFreeColors (dpy, cmap, &pixel, 1, 0);
  UNBLOCK_INPUT;
}

/* Initializing face arrays for frames. */

423 424 425 426 427 428
/* Set up faces 0 and 1 based on the normal text and modeline GC's.
   This gets called whenever the parameters stored in the frame itself
   (i.e. font, background color, etcetera) change.

   Note that the first two faces just contain references to the
   frame's own resources.  We shouldn't free them.  */
429 430 431 432 433 434 435 436 437 438 439 440 441 442
void
init_frame_faces (f)
     struct frame *f;
{
  ensure_face_ready (f, 0);
  {
    XGCValues gcv;
    struct face *face = FRAME_FACES (f) [0];

    XGetGCValues (x_current_display, f->display.x->normal_gc,
		  GCForeground | GCBackground | GCFont, &gcv);
    face->gc         = f->display.x->normal_gc;
    face->foreground = gcv.foreground;
    face->background = gcv.background;
443
    face->font       = f->display.x->font;
444 445 446 447 448 449 450 451 452 453 454 455 456 457
    face->stipple = 0;
    face->underline = 0;
  }

  ensure_face_ready (f, 1);
  {
    XGCValues gcv;
    struct face *face = FRAME_FACES (f) [1];

    XGetGCValues (x_current_display, f->display.x->reverse_gc,
		  GCForeground | GCBackground | GCFont, &gcv);
    face->gc         = f->display.x->reverse_gc;
    face->foreground = gcv.foreground;
    face->background = gcv.background;
458
    face->font       = f->display.x->font;
459 460 461 462 463 464 465 466 467 468 469 470 471
    face->stipple = 0;
    face->underline = 0;
  }
}

/* Called from Fdelete_frame.  */
void
free_frame_faces (f)
     struct frame *f;
{
  Display *dpy = x_current_display;
  int i;

472 473 474 475
  /* The first two faces on the frame are just made of resources which 
     we borrowed from the frame's GC's, so don't free them.  Let
     them get freed by the x_destroy_window code.  */
  for (i = 2; i < FRAME_N_FACES (f); i++)
476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
    {
      struct face *face = FRAME_FACES (f) [i];
      if (! face)
        continue;
      if (face->gc)
	XFreeGC (dpy, face->gc);
      unload_font (f, face->font);
      unload_color (f, face->foreground);
      unload_color (f, face->background);
#if 0
      unload_pixmap (f, face->stipple);
#endif
      xfree (face);
    }
  xfree (FRAME_FACES (f));
  FRAME_FACES (f) = 0;
  FRAME_N_FACES (f) = 0;
}
Jim Blandy's avatar
Jim Blandy committed
494

495 496 497 498 499
/* Interning faces in a frame's face array.  */

/* Find a match for NEW_FACE in a FRAME's face array, and add it if we don't
   find one.  */
int
500
intern_frame_face (frame, new_face)
501
     struct frame *frame;
502
     struct face *new_face;
503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519
{
  int len = FRAME_N_FACES (frame);
  int i;

  /* Search for a face already on FRAME equivalent to FACE.  */
  for (i = 0; i < len; i++)
    {
      struct face *frame_face = FRAME_FACES (frame)[i];
      
      if (frame_face && face_eql (new_face, frame_face))
	return i;
    }

  /* We didn't find one; add a new one.  */
  i = next_face_id++;

  ensure_face_ready (frame, i);
520
  bcopy (new_face, FRAME_FACES (frame)[i], sizeof (*new_face));
521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554

  return i;
}

/* Make face id ID valid on frame F.  */

static void
ensure_face_ready (f, id)
     struct frame *f;
     int id;
{
  if (FRAME_N_FACES (f) <= id)
    {
      int n = id + 10;
      int i;
      if (!FRAME_N_FACES (f))
	FRAME_FACES (f)
	  = (struct face **) xmalloc (sizeof (struct face *) * n);
      else
	FRAME_FACES (f)
	  = (struct face **) xrealloc (FRAME_FACES (f),
				       sizeof (struct face *) * n);

      bzero (FRAME_FACES (f) + FRAME_N_FACES (f),
	     (n - FRAME_N_FACES (f)) * sizeof (struct face *));
      FRAME_N_FACES (f) = n;
    }

  if (FRAME_FACES (f) [id] == 0)
    FRAME_FACES (f) [id] = allocate_face ();
}

/* Computing faces appropriate for a given piece of text in a buffer.  */

555 556 557 558 559 560
/* Return non-zero if FONT1 and FONT2 have the same size bounding box.
   We assume that they're both character-cell fonts.  */
static int
same_size_fonts (font1, font2)
     XFontStruct *font1, *font2;
{
Jim Blandy's avatar
Jim Blandy committed
561 562
  XCharStruct *bounds1 = &font1->min_bounds;
  XCharStruct *bounds2 = &font2->min_bounds;
563 564 565 566 567 568 569

  return (bounds1->width == bounds2->width
	  && bounds1->ascent == bounds2->ascent
	  && bounds1->descent == bounds2->descent);
}


Jim Blandy's avatar
Jim Blandy committed
570 571 572 573 574 575
/* Modify face TO by copying from FROM all properties which have
   nondefault settings.  */
static void 
merge_faces (from, to)
     struct face *from, *to;
{
576 577 578 579 580
  /* Only merge the font if it's the same size as the base font.  */
  if (from->font != (XFontStruct *) FACE_DEFAULT
      && ! from->font->per_char
      && same_size_fonts (from->font, to->font))
    to->font = from->font;
Jim Blandy's avatar
Jim Blandy committed
581 582 583 584
  if (from->foreground != FACE_DEFAULT)
    to->foreground = from->foreground;
  if (from->background != FACE_DEFAULT)
    to->background = from->background;
Jim Blandy's avatar
Jim Blandy committed
585 586
  if (from->stipple != FACE_DEFAULT)
    to->stipple = from->stipple;
Jim Blandy's avatar
Jim Blandy committed
587 588 589 590
  if (from->underline)
    to->underline = from->underline;
}

Jim Blandy's avatar
Jim Blandy committed
591 592 593 594 595 596 597
struct sortvec
{
  Lisp_Object overlay;
  int beg, end;
  int priority;
};

598 599 600 601 602 603 604 605 606 607 608 609 610 611
static int
sort_overlays (s1, s2)
     struct sortvec *s1, *s2;
{
  if (s1->priority != s2->priority)
    return s1->priority - s2->priority;
  if (s1->beg != s2->beg)
    return s1->beg - s2->beg;
  if (s1->end != s2->end)
    return s2->end - s1->end;
  return 0;
}

/* Return the face ID associated with a buffer position POS.
Jim Blandy's avatar
Jim Blandy committed
612 613
   Store into *ENDPTR the position at which a different face is needed.
   This does not take account of glyphs that specify their own face codes.
614
   F is the frame in use for display, and W is a window displaying
615 616 617 618
   the current buffer.

   REGION_BEG, REGION_END delimit the region, so it can be highlighted.  */

619
int
620
compute_char_face (f, w, pos, region_beg, region_end, endptr)
Jim Blandy's avatar
Jim Blandy committed
621
     struct frame *f;
Jim Blandy's avatar
Jim Blandy committed
622
     struct window *w;
Jim Blandy's avatar
Jim Blandy committed
623
     int pos;
624
     int region_beg, region_end;
Jim Blandy's avatar
Jim Blandy committed
625 626 627
     int *endptr;
{
  struct face face;
628
  Lisp_Object prop, position;
Jim Blandy's avatar
Jim Blandy committed
629 630 631
  int i, j, noverlays;
  int facecode;
  Lisp_Object *overlay_vec;
Jim Blandy's avatar
Jim Blandy committed
632 633
  struct sortvec *sortvec;
  Lisp_Object frame;
634 635 636 637 638 639
  int endpos;

  /* W must display the current buffer.  We could write this function
     to use the frame and buffer of W, but right now it doesn't.  */
  if (XBUFFER (w->buffer) != current_buffer)
    abort ();
Jim Blandy's avatar
Jim Blandy committed
640 641

  XSET (frame, Lisp_Frame, f);
Jim Blandy's avatar
Jim Blandy committed
642

643
  endpos = ZV;
644 645
  if (pos < region_beg && region_beg < endpos)
    endpos = region_beg;
646

Jim Blandy's avatar
Jim Blandy committed
647
  XFASTINT (position) = pos;
648 649 650
  prop = Fget_text_property (position, Qface, w->buffer);
  {
    Lisp_Object end;
Jim Blandy's avatar
Jim Blandy committed
651

652 653 654 655 656 657
    end = Fnext_single_property_change (position, Qface, w->buffer);
    if (INTEGERP (end))
      endpos = XINT (end);
  }

  {
658
    int next_overlay;
659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674
    int len;

    /* First try with room for 40 overlays.  */
    len = 40;
    overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
    
    noverlays = overlays_at (pos, 0, &overlay_vec, &len, &next_overlay);

    /* If there are more than 40,
       make enough space for all, and try again.  */
    if (noverlays > len)
      {
	len = noverlays;
	overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
	noverlays = overlays_at (pos, 0, &overlay_vec, &len, &next_overlay);
      }
675

676 677
    if (next_overlay < endpos)
      endpos = next_overlay;
678 679 680
  }

  *endptr = endpos;
Jim Blandy's avatar
Jim Blandy committed
681 682

  /* Optimize the default case.  */
683 684
  if (noverlays == 0 && NILP (prop)
      && !(pos >= region_beg && pos < region_end))
685
    return 0;
Jim Blandy's avatar
Jim Blandy committed
686

Jim Blandy's avatar
Jim Blandy committed
687
  bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (struct face));
688
  face.gc = 0;
Jim Blandy's avatar
Jim Blandy committed
689 690 691

  if (!NILP (prop))
    {
Jim Blandy's avatar
Jim Blandy committed
692 693 694 695
      facecode = face_name_id_number (frame, prop);
      if (facecode >= 0 && facecode < FRAME_N_FACES (f)
	  && FRAME_FACES (f) [facecode] != 0)
	merge_faces (FRAME_FACES (f) [facecode], &face);
Jim Blandy's avatar
Jim Blandy committed
696 697
    }

Jim Blandy's avatar
Jim Blandy committed
698 699 700
  /* Put the valid and relevant overlays into sortvec.  */
  sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));

Jim Blandy's avatar
Jim Blandy committed
701 702
  for (i = 0, j = 0; i < noverlays; i++)
    {
703
      Lisp_Object overlay = overlay_vec[i];
Jim Blandy's avatar
Jim Blandy committed
704 705 706 707

      if (OVERLAY_VALID (overlay)
	  && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
	  && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
Jim Blandy's avatar
Jim Blandy committed
708 709 710 711 712 713
	{
	  Lisp_Object window;
	  window = Foverlay_get (overlay, Qwindow);

	  /* Also ignore overlays limited to one window
	     if it's not the window we are using.  */
714 715
	  if (XTYPE (window) != Lisp_Window
	      || XWINDOW (window) == w)
Jim Blandy's avatar
Jim Blandy committed
716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731
	    {
	      Lisp_Object tem;

	      /* This overlay is good and counts:
		 put it in sortvec.  */
	      sortvec[j].overlay = overlay;
	      sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
	      sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
	      tem = Foverlay_get (overlay, Qpriority);
	      if (INTEGERP (tem))
		sortvec[j].priority = XINT (tem);
	      else
		sortvec[j].priority = 0;
	      j++;
	    }
	}
Jim Blandy's avatar
Jim Blandy committed
732 733 734
    }
  noverlays = j;

Jim Blandy's avatar
Jim Blandy committed
735 736
  /* Sort the overlays into the proper order: increasing priority.  */

737 738
  if (noverlays > 1)
    qsort (sortvec, noverlays, sizeof (struct sortvec), sort_overlays);
Jim Blandy's avatar
Jim Blandy committed
739 740 741 742

  /* Now merge the overlay data in that order.  */
  for (i = 0; i < noverlays; i++)
    {
743
      prop = Foverlay_get (sortvec[i].overlay, Qface);
Jim Blandy's avatar
Jim Blandy committed
744 745 746 747 748
      if (!NILP (prop))
	{
	  Lisp_Object oend;
	  int oendpos;

Jim Blandy's avatar
Jim Blandy committed
749 750 751 752
	  facecode = face_name_id_number (frame, prop);
	  if (facecode >= 0 && facecode < FRAME_N_FACES (f)
	      && FRAME_FACES (f) [facecode] != 0)
	    merge_faces (FRAME_FACES (f) [facecode], &face);
Jim Blandy's avatar
Jim Blandy committed
753

754
	  oend = OVERLAY_END (sortvec[i].overlay);
Jim Blandy's avatar
Jim Blandy committed
755
	  oendpos = OVERLAY_POSITION (oend);
756
	  if (oendpos < endpos)
Jim Blandy's avatar
Jim Blandy committed
757 758 759 760
	    endpos = oendpos;
	}
    }

761 762 763 764 765 766 767 768
  if (pos >= region_beg && pos < region_end)
    {
      if (region_end < endpos)
	endpos = region_end;
      if (region_face >= 0 && region_face < next_face_id)
	merge_faces (FRAME_FACES (f) [region_face], &face);
    }

Jim Blandy's avatar
Jim Blandy committed
769 770
  *endptr = endpos;

771
  return intern_frame_face (f, &face);
Jim Blandy's avatar
Jim Blandy committed
772 773
}

774 775 776 777
/* Return the face ID to use to display a special glyph which selects
   FACE_CODE as the face ID, assuming that ordinarily the face would
   be BASIC_FACE.  F is the frame.  */
int
778
compute_glyph_face (f, face_code)
Jim Blandy's avatar
Jim Blandy committed
779 780 781 782 783
     struct frame *f;
     int face_code;
{
  struct face face;

784
  bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (face));
785
  face.gc = 0;
Jim Blandy's avatar
Jim Blandy committed
786

Jim Blandy's avatar
Jim Blandy committed
787 788 789
  if (face_code >= 0 && face_code < FRAME_N_FACES (f)
      && FRAME_FACES (f) [face_code] != 0)
    merge_faces (FRAME_FACES (f) [face_code], &face);
Jim Blandy's avatar
Jim Blandy committed
790

791
  return intern_frame_face (f, &face);
Jim Blandy's avatar
Jim Blandy committed
792 793
}

794
/* Lisp interface. */
Jim Blandy's avatar
Jim Blandy committed
795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823

DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0,
       "")
     (frame)
     Lisp_Object frame;
{
  CHECK_FRAME (frame, 0);
  return XFRAME (frame)->face_alist;
}

DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist,
       2, 2, 0, "")
     (frame, value)
     Lisp_Object frame, value;
{
  CHECK_FRAME (frame, 0);
  XFRAME (frame)->face_alist = value;
  return value;
}


DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0,
  "Create face number FACE-ID on all frames.")
  (face_id)
     Lisp_Object face_id;
{
  Lisp_Object rest;
  int id = XINT (face_id);

Jim Blandy's avatar
Jim Blandy committed
824 825 826
  CHECK_NUMBER (face_id, 0);
  if (id < 0 || id >= next_face_id)
    error ("Face id out of range");
Jim Blandy's avatar
Jim Blandy committed
827 828 829 830

  for (rest = Vframe_list; !NILP (rest); rest = XCONS (rest)->cdr)
    {
      struct frame *f = XFRAME (XCONS (rest)->car);
831 832
      if (FRAME_X_P (f))
	ensure_face_ready (f, id);
Jim Blandy's avatar
Jim Blandy committed
833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848
    }
  return Qnil;
}


DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal,
       Sset_face_attribute_internal, 4, 4, 0, "")
     (face_id, attr_name, attr_value, frame)
     Lisp_Object face_id, attr_name, attr_value, frame;
{
  struct face *face;
  struct frame *f;
  int magic_p;
  int id;

  CHECK_FRAME (frame, 0);
Jim Blandy's avatar
Jim Blandy committed
849
  CHECK_NUMBER (face_id, 0);
Jim Blandy's avatar
Jim Blandy committed
850 851 852 853
  CHECK_SYMBOL (attr_name, 0);

  f = XFRAME (frame);
  id = XINT (face_id);
Jim Blandy's avatar
Jim Blandy committed
854 855
  if (id < 0 || id >= next_face_id)
    error ("Face id out of range");
Jim Blandy's avatar
Jim Blandy committed
856

857 858 859
  if (! FRAME_X_P (f))
    return;

Jim Blandy's avatar
Jim Blandy committed
860
  ensure_face_ready (f, id);
Jim Blandy's avatar
Jim Blandy committed
861
  face = FRAME_FACES (f) [XFASTINT (face_id)];
Jim Blandy's avatar
Jim Blandy committed
862 863 864

  if (EQ (attr_name, intern ("font")))
    {
Jim Blandy's avatar
Jim Blandy committed
865
      XFontStruct *font = load_font (f, attr_value);
Jim Blandy's avatar
Jim Blandy committed
866 867 868 869 870
      unload_font (f, face->font);
      face->font = font;
    }
  else if (EQ (attr_name, intern ("foreground")))
    {
Jim Blandy's avatar
Jim Blandy committed
871
      unsigned long new_color = load_color (f, attr_value);
Jim Blandy's avatar
Jim Blandy committed
872 873 874 875 876
      unload_color (f, face->foreground);
      face->foreground = new_color;
    }
  else if (EQ (attr_name, intern ("background")))
    {
Jim Blandy's avatar
Jim Blandy committed
877
      unsigned long new_color = load_color (f, attr_value);
Jim Blandy's avatar
Jim Blandy committed
878 879 880 881 882 883 884 885
      unload_color (f, face->background);
      face->background = new_color;
    }
#if 0
  else if (EQ (attr_name, intern ("background-pixmap")))
    {
      unsigned int w, h, d;
      unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h, &d, 0);
Jim Blandy's avatar
Jim Blandy committed
886 887 888 889
      unload_pixmap (f, face->stipple);
      if (NILP (attr_value))
	new_pixmap = 0;
      face->stipple = new_pixmap;
Jim Blandy's avatar
Jim Blandy committed
890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905
      face->pixmap_w = w;
      face->pixmap_h = h;
/*      face->pixmap_depth = d; */
    }
#endif /* 0 */
  else if (EQ (attr_name, intern ("underline")))
    {
      int new = !NILP (attr_value);
      face->underline = new;
    }
  else
    error ("unknown face attribute");

  if (id == 0)
    {
      BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
906 907 908
      if (FRAME_DEFAULT_FACE (f)->gc != 0)
	XFreeGC (x_current_display, FRAME_DEFAULT_FACE (f)->gc);
      build_face (f, FRAME_DEFAULT_FACE (f));
Jim Blandy's avatar
Jim Blandy committed
909 910 911 912 913 914
      UNBLOCK_INPUT;
    }

  if (id == 1)
    {
      BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
915 916 917
      if (FRAME_MODE_LINE_FACE (f)->gc != 0)
	XFreeGC (x_current_display, FRAME_MODE_LINE_FACE (f)->gc);
      build_face (f, FRAME_MODE_LINE_FACE (f));
Jim Blandy's avatar
Jim Blandy committed
918 919 920
      UNBLOCK_INPUT;
    }

921 922 923 924 925 926 927 928 929 930 931
  /* If we're modifying either of the frame's display faces, that
     means that we're changing the parameters of a fixed face code;
     since the color/font/whatever is changed but the face ID hasn't,
     redisplay won't know to redraw the affected sections.  Give it a
     kick.  */
  if (id == 0 || id == 1)
    SET_FRAME_GARBAGED (f);
  else
    /* Otherwise, it's enough to tell it to redisplay the text.  */
    windows_or_buffers_changed = 1;

Jim Blandy's avatar
Jim Blandy committed
932 933 934 935 936 937 938 939 940
  return Qnil;
}

DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id,
  0, 0, 0, "")
  ()
{
  return make_number (next_face_id++);
}
Jim Blandy's avatar
Jim Blandy committed
941 942 943 944 945 946 947 948 949 950 951 952 953 954

/* Return the face id for name NAME on frame FRAME.
   (It should be the same for all frames,
   but it's as easy to use the "right" frame to look it up
   as to use any other one.)  */

static Lisp_Object
face_name_id_number (frame, name)
     Lisp_Object frame, name;
{
  Lisp_Object tem;

  CHECK_FRAME (frame, 0);
  tem = Fcdr (Fassq (name, XFRAME (frame)->face_alist));
955 956
  if (NILP (tem))
    return 0;
Jim Blandy's avatar
Jim Blandy committed
957 958 959 960 961
  CHECK_VECTOR (tem, 0);
  tem = XVECTOR (tem)->contents[2];
  CHECK_NUMBER (tem, 0);
  return XINT (tem);
}
Jim Blandy's avatar
Jim Blandy committed
962

963 964
/* Emacs initialization.  */

Jim Blandy's avatar
Jim Blandy committed
965
void
Jim Blandy's avatar
Jim Blandy committed
966
syms_of_xfaces ()
Jim Blandy's avatar
Jim Blandy committed
967
{
Jim Blandy's avatar
Jim Blandy committed
968 969 970 971 972 973 974
  Qwindow = intern ("window");
  staticpro (&Qwindow);
  Qface = intern ("face");
  staticpro (&Qface);
  Qpriority = intern ("priority");
  staticpro (&Qpriority);

975 976 977 978 979
  DEFVAR_INT ("region-face", &region_face,
    "Face number to use to highlight the region\n\
The region is highlighted with this face\n\
when Transient Mark mode is enabled and the mark is active.");

Jim Blandy's avatar
Jim Blandy committed
980 981 982 983 984 985
  defsubr (&Sframe_face_alist);
  defsubr (&Sset_frame_face_alist);
  defsubr (&Smake_face_internal);
  defsubr (&Sset_face_attribute_internal);
  defsubr (&Sinternal_next_face_id);
}
986 987 988

#endif /* HAVE_X_WINDOWS */