xfaces.c 19.4 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* "Face" primitives
Jim Blandy's avatar
Jim Blandy committed
2 3
   Copyright (C) 1992, 1993 Free Software Foundation.

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 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 28 29
#include <sys/types.h>
#include <sys/stat.h>

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

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

/* Display Context for the icons */ 
#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>
#include <X11/Xmu/Drawing.h>
#include <X11/Xos.h>

Jim Blandy's avatar
Jim Blandy committed
40
/* We use face structures in two ways:
Jim Blandy's avatar
Jim Blandy committed
41 42
   At the frame level, each frame has a vector of faces (FRAME_FACES).
   Face number 0 is the default face (for normal text).
Jim Blandy's avatar
Jim Blandy committed
43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
   Face number 1 is the mode line face.
   Higher face numbers have no built-in meaning.
   The faces in these vectors are called "frame faces".

   Faces number 0 and 1 have graphics contexts.
   They can be user in the redisplay code directly.
   Higher numbered frame faces do not have graphics contexts.

   There are also "cached faces".  They have graphics contexts.
   They are kept in a C vector called face_vector.

   A "display face" is a face with a graphics context.
   It is either a frame face number 0 or 1,
   or a cached face.  */
   
Jim Blandy's avatar
Jim Blandy committed
58 59 60 61 62 63 64 65 66 67
/* 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;

Jim Blandy's avatar
Jim Blandy committed
68 69
#define FACE_DEFAULT (~0)

Jim Blandy's avatar
Jim Blandy committed
70 71 72 73
#define xfree free

Lisp_Object Qface, Qwindow, Qpriority;

Jim Blandy's avatar
Jim Blandy committed
74 75
static struct face *allocate_face ();
static void build_face ();
Jim Blandy's avatar
Jim Blandy committed
76 77 78
static int sort_overlays ();
static struct face *get_display_face ();
static Lisp_Object face_name_id_number ();
Jim Blandy's avatar
Jim Blandy committed
79 80 81 82 83 84 85 86 87 88 89 90

/* Make a new face that's a copy of an existing one.  */

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
91
  result->stipple = face->stipple;
Jim Blandy's avatar
Jim Blandy committed
92 93 94 95 96 97 98 99 100 101 102 103
  result->underline = face->underline;

  return result;
}

static int
face_eql (face1, face2)
     struct face *face1, *face2;
{
  return (face1->font == face2->font
	  && face1->foreground == face2->foreground
	  && face1->background == face2->background
Jim Blandy's avatar
Jim Blandy committed
104
	  && face1->stipple == face2->stipple
Jim Blandy's avatar
Jim Blandy committed
105 106 107 108 109 110 111 112 113
	  && face1->underline == face2->underline);
}

/* 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
114
get_cached_face (f, face)
Jim Blandy's avatar
Jim Blandy committed
115 116 117 118
     struct frame *f;
     struct face *face;
{
  int i, empty = -1;
Jim Blandy's avatar
Jim Blandy committed
119
  struct face *result;
Jim Blandy's avatar
Jim Blandy committed
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163

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

/* 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
164
  int i;
Jim Blandy's avatar
Jim Blandy committed
165 166 167 168 169 170

  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
171 172
      if (face->gc)
	XFreeGC (dpy, face->gc);
Jim Blandy's avatar
Jim Blandy committed
173 174 175 176 177 178 179
      xfree (face);
    }
  nfaces = 0;

  UNBLOCK_INPUT;
}

Jim Blandy's avatar
Jim Blandy committed
180 181
/* Make a graphics context for face FACE, which is on frame F,
   if that can be done.  */
Jim Blandy's avatar
Jim Blandy committed
182 183 184 185 186 187 188 189 190 191

static void
build_face (f, face)
     struct frame* f;
     struct face* face;
{
  GC gc;
  XGCValues xgcv;
  unsigned long mask;

Jim Blandy's avatar
Jim Blandy committed
192 193 194 195 196 197 198 199 200 201 202 203
  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
204 205 206 207 208
  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
209 210
  if (face->stipple && face->stipple != FACE_DEFAULT)
    XSetStipple (x_current_display, gc, face->stipple);
Jim Blandy's avatar
Jim Blandy committed
211
#endif
Jim Blandy's avatar
Jim Blandy committed
212
  face->gc = gc;
Jim Blandy's avatar
Jim Blandy committed
213 214
}

Jim Blandy's avatar
Jim Blandy committed
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
/* Modify face TO by copying from FROM all properties which have
   nondefault settings.  */

static void 
merge_faces (from, to)
     struct face *from, *to;
{
  if (from->font != (XFontStruct *)FACE_DEFAULT)
    {
      to->font = from->font;
    }
  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
230 231
  if (from->stipple != FACE_DEFAULT)
    to->stipple = from->stipple;
Jim Blandy's avatar
Jim Blandy committed
232 233 234 235
  if (from->underline)
    to->underline = from->underline;
}

Jim Blandy's avatar
Jim Blandy committed
236 237 238 239 240 241 242
struct sortvec
{
  Lisp_Object overlay;
  int beg, end;
  int priority;
};

Jim Blandy's avatar
Jim Blandy committed
243 244 245
/* Return the display face associated with a buffer position POS.
   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.
Jim Blandy's avatar
Jim Blandy committed
246
   F is the frame in use for display, and W is the window.  */
Jim Blandy's avatar
Jim Blandy committed
247 248

struct face *
Jim Blandy's avatar
Jim Blandy committed
249
compute_char_face (f, w, pos, endptr)
Jim Blandy's avatar
Jim Blandy committed
250
     struct frame *f;
Jim Blandy's avatar
Jim Blandy committed
251
     struct window *w;
Jim Blandy's avatar
Jim Blandy committed
252 253 254 255 256 257 258 259 260 261 262
     int pos;
     int *endptr;
{
  struct face face;
  Lisp_Object prop, position, length;
  Lisp_Object overlay, start, end;
  int i, j, noverlays;
  int facecode;
  int endpos;
  Lisp_Object *overlay_vec;
  int len;
Jim Blandy's avatar
Jim Blandy committed
263 264 265 266
  struct sortvec *sortvec;
  Lisp_Object frame;

  XSET (frame, Lisp_Frame, f);
Jim Blandy's avatar
Jim Blandy committed
267 268 269 270 271 272 273 274 275 276

  XFASTINT (position) = pos;
  prop = Fget_text_property (position, Qface);

  len = 10;
  overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
  noverlays = overlays_at (pos, &overlay_vec, &len, &endpos);

  /* Optimize the default case.  */
  if (noverlays == 0 && NILP (prop))
Jim Blandy's avatar
Jim Blandy committed
277
    return FRAME_DEFAULT_FACE (f);
Jim Blandy's avatar
Jim Blandy committed
278

Jim Blandy's avatar
Jim Blandy committed
279
  bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (struct face));
Jim Blandy's avatar
Jim Blandy committed
280 281 282

  if (!NILP (prop))
    {
Jim Blandy's avatar
Jim Blandy committed
283 284 285 286
      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
287 288
    }

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

Jim Blandy's avatar
Jim Blandy committed
292 293 294 295 296 297 298
  for (i = 0, j = 0; i < noverlays; i++)
    {
      overlay = overlay_vec[i];

      if (OVERLAY_VALID (overlay)
	  && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
	  && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
Jim Blandy's avatar
Jim Blandy committed
299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321
	{
	  Lisp_Object window;
	  window = Foverlay_get (overlay, Qwindow);

	  /* Also ignore overlays limited to one window
	     if it's not the window we are using.  */
	  if (NILP (window) || XWINDOW (window) == w)
	    {
	      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
322 323 324
    }
  noverlays = j;

Jim Blandy's avatar
Jim Blandy committed
325 326 327
  /* Sort the overlays into the proper order: increasing priority.  */

  qsort (sortvec, noverlays, sizeof (struct sortvec), sort_overlays);
Jim Blandy's avatar
Jim Blandy committed
328 329 330 331 332 333 334 335 336 337 338

  /* Now merge the overlay data in that order.  */

  for (i = 0; i < noverlays; i++)
    {
      prop = Foverlay_get (overlay_vec[i], Qface);
      if (!NILP (prop))
	{
	  Lisp_Object oend;
	  int oendpos;

Jim Blandy's avatar
Jim Blandy committed
339 340 341 342
	  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
343 344 345 346 347 348 349 350 351 352 353 354 355 356 357

	  oend = OVERLAY_END (overlay_vec[i]);
	  oendpos = OVERLAY_POSITION (oend);
	  if (oendpos > endpos)
	    endpos = oendpos;
	}
    }

  xfree (overlay_vec);

  *endptr = endpos;

  return get_display_face (f, &face);
}

Jim Blandy's avatar
Jim Blandy committed
358 359 360 361 362 363 364 365 366 367 368 369 370
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;
}

Jim Blandy's avatar
Jim Blandy committed
371 372 373 374 375 376 377 378 379 380 381 382 383 384 385
/* Return the display face 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.  */

struct face *
compute_glyph_face (f, basic_face, face_code)
     struct frame *f;
     struct face *basic_face;
     int face_code;
{
  struct face face;

  bcopy (basic_face, &face, sizeof (struct face));

Jim Blandy's avatar
Jim Blandy committed
386 387 388
  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
389 390 391 392

  return get_display_face (f, &face);
}

Jim Blandy's avatar
Jim Blandy committed
393 394 395 396 397 398 399 400 401 402 403
/* Given a frame face, return an equivalent display face
   (one which has a graphics context).  */

static struct face *
get_display_face (f, face)
     struct frame *f;
     struct face *face;
{
  struct face *result;

  /* Does the face have a GC already?  */
Jim Blandy's avatar
Jim Blandy committed
404
  if (face->gc)
Jim Blandy's avatar
Jim Blandy committed
405 406
    return face;
  
Jim Blandy's avatar
Jim Blandy committed
407 408 409 410 411 412
  /* If it's equivalent to the default face, use that.  */
  if (face->font == FRAME_DEFAULT_FACE (f)->font
      && face->foreground == FRAME_DEFAULT_FACE (f)->foreground
      && face->background == FRAME_DEFAULT_FACE (f)->background
      && face->stipple == FRAME_DEFAULT_FACE (f)->stipple
      && face->underline == FRAME_DEFAULT_FACE (f)->underline)
Jim Blandy's avatar
Jim Blandy committed
413
    {
Jim Blandy's avatar
Jim Blandy committed
414 415 416
      if (!FRAME_DEFAULT_FACE (f)->gc)
	build_face (f, FRAME_DEFAULT_FACE (f));
      return FRAME_DEFAULT_FACE (f);
Jim Blandy's avatar
Jim Blandy committed
417 418 419
    }

  /* If it's equivalent to the mode line face, use that.  */
Jim Blandy's avatar
Jim Blandy committed
420 421 422 423 424
  if (face->font == FRAME_MODE_LINE_FACE (f)->font
      && face->foreground == FRAME_MODE_LINE_FACE (f)->foreground
      && face->background == FRAME_MODE_LINE_FACE (f)->background
      && face->stipple == FRAME_MODE_LINE_FACE (f)->stipple
      && face->underline == FRAME_MODE_LINE_FACE (f)->underline)
Jim Blandy's avatar
Jim Blandy committed
425
    {
Jim Blandy's avatar
Jim Blandy committed
426 427 428
      if (!FRAME_MODE_LINE_FACE (f)->gc)
	build_face (f, FRAME_MODE_LINE_FACE (f));
      return FRAME_MODE_LINE_FACE (f);
Jim Blandy's avatar
Jim Blandy committed
429 430 431 432 433 434 435 436 437 438 439 440 441
    }

  /* Get a specialized display face.  */
  return get_cached_face (f, face);
}


/* Allocate a new face */
static struct face *
allocate_face ()
{
  struct face *result = (struct face *) xmalloc (sizeof (struct face));
  bzero (result, sizeof (struct face));
Jim Blandy's avatar
Jim Blandy committed
442 443 444
  result->font = (XFontStruct *) FACE_DEFAULT;
  result->foreground = FACE_DEFAULT;
  result->background = FACE_DEFAULT;
Jim Blandy's avatar
Jim Blandy committed
445
  result->stipple = FACE_DEFAULT;
Jim Blandy's avatar
Jim Blandy committed
446 447 448 449 450 451 452 453 454 455
  return result;
}

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

void
ensure_face_ready (f, id)
     struct frame *f;
     int id;
{
Jim Blandy's avatar
Jim Blandy committed
456
  if (FRAME_N_FACES (f) <= id)
Jim Blandy's avatar
Jim Blandy committed
457 458 459
    {
      int n = id + 10;
      int i;
Jim Blandy's avatar
Jim Blandy committed
460 461 462
      if (!FRAME_N_FACES (f))
	FRAME_FACES (f)
	  = (struct face **) xmalloc (sizeof (struct face *) * n);
Jim Blandy's avatar
Jim Blandy committed
463
      else
Jim Blandy's avatar
Jim Blandy committed
464 465 466
	FRAME_FACES (f)
	  = (struct face **) xrealloc (FRAME_FACES (f),
				       sizeof (struct face *) * n);
Jim Blandy's avatar
Jim Blandy committed
467

Jim Blandy's avatar
Jim Blandy committed
468 469 470
      bzero (FRAME_FACES (f) + FRAME_N_FACES (f),
	     (n - FRAME_N_FACES (f)) * sizeof (struct face *));
      FRAME_N_FACES (f) = n;
Jim Blandy's avatar
Jim Blandy committed
471 472
    }

Jim Blandy's avatar
Jim Blandy committed
473 474
  if (FRAME_FACES (f) [id] == 0)
    FRAME_FACES (f) [id] = allocate_face ();
Jim Blandy's avatar
Jim Blandy committed
475 476 477 478 479 480 481 482 483 484 485 486 487
}

/* Allocating, freeing, and duplicating fonts, colors, and pixmaps.  */

#ifdef HAVE_X_WINDOWS

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

Jim Blandy's avatar
Jim Blandy committed
488 489 490
  if (NILP (name))
    return (XFontStruct *) FACE_DEFAULT;

Jim Blandy's avatar
Jim Blandy committed
491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521
  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;

Jim Blandy's avatar
Jim Blandy committed
522 523 524
  if (NILP (name))
    return FACE_DEFAULT;

Jim Blandy's avatar
Jim Blandy committed
525
  cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
Jim Blandy's avatar
Jim Blandy committed
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

  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;
  if (pixel == FACE_DEFAULT)
    return;
Jim Blandy's avatar
Jim Blandy committed
552
  cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
Jim Blandy's avatar
Jim Blandy committed
553 554 555 556 557 558 559 560 561 562 563 564
  BLOCK_INPUT;
  XFreeColors (dpy, cmap, &pixel, 1, 0);
  UNBLOCK_INPUT;
}

#endif /* HAVE_X_WINDOWS */


/* frames */

void
init_frame_faces (f)
Jim Blandy's avatar
Jim Blandy committed
565
     struct frame *f;
Jim Blandy's avatar
Jim Blandy committed
566 567 568 569 570 571 572
{
  struct frame *other_frame = 0;
  Lisp_Object rest;

  for (rest = Vframe_list; !NILP (rest); rest = Fcdr (rest))
    {
      struct frame *f2 = XFRAME (Fcar (rest));
Jim Blandy's avatar
Jim Blandy committed
573
      if (f2 != f && FRAME_X_P (f2))
Jim Blandy's avatar
Jim Blandy committed
574 575 576 577 578 579 580 581 582
	{
	  other_frame = f2;
	  break;
	}
    }

  if (other_frame)
    {
      /* Make sure this frame's face vector is as big as the others.  */
Jim Blandy's avatar
Jim Blandy committed
583 584 585
      FRAME_N_FACES (f) = FRAME_N_FACES (other_frame);
      FRAME_FACES (f)
	= (struct face **) xmalloc (FRAME_N_FACES (f) * sizeof (struct face *));
Jim Blandy's avatar
Jim Blandy committed
586 587

      /* Make sure the frame has the two basic faces.  */
Jim Blandy's avatar
Jim Blandy committed
588 589 590 591
      FRAME_DEFAULT_FACE (f)
	= copy_face (FRAME_DEFAULT_FACE (other_frame));
      FRAME_MODE_LINE_FACE (f)
	= copy_face (FRAME_MODE_LINE_FACE (other_frame));
Jim Blandy's avatar
Jim Blandy committed
592 593 594 595 596 597 598 599 600 601 602 603 604
    }
}


/* Called from Fdelete_frame?  */

void
free_screen_faces (f)
     struct frame *f;
{
  Display *dpy = x_current_display;
  int i;

Jim Blandy's avatar
Jim Blandy committed
605
  for (i = 0; i < FRAME_N_FACES (f); i++)
Jim Blandy's avatar
Jim Blandy committed
606
    {
Jim Blandy's avatar
Jim Blandy committed
607
      struct face *face = FRAME_FACES (f) [i];
Jim Blandy's avatar
Jim Blandy committed
608 609
      if (! face)
        continue;
Jim Blandy's avatar
Jim Blandy committed
610 611
      if (face->gc)
	XFreeGC (dpy, face->gc);
Jim Blandy's avatar
Jim Blandy committed
612 613 614
      unload_font (f, face->font);
      unload_color (f, face->foreground);
      unload_color (f, face->background);
Jim Blandy's avatar
Jim Blandy committed
615 616 617
#if 0
      unload_pixmap (f, face->stipple);
#endif
Jim Blandy's avatar
Jim Blandy committed
618 619
      xfree (face);
    }
Jim Blandy's avatar
Jim Blandy committed
620 621 622
  xfree (FRAME_FACES (f));
  FRAME_FACES (f) = 0;
  FRAME_N_FACES (f) = 0;
Jim Blandy's avatar
Jim Blandy committed
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
}


/* Lisp interface */

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
656 657 658
  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
659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679

  for (rest = Vframe_list; !NILP (rest); rest = XCONS (rest)->cdr)
    {
      struct frame *f = XFRAME (XCONS (rest)->car);
      ensure_face_ready (f, id);
    }
  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
680
  CHECK_NUMBER (face_id, 0);
Jim Blandy's avatar
Jim Blandy committed
681 682 683 684
  CHECK_SYMBOL (attr_name, 0);

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

  ensure_face_ready (f, id);
Jim Blandy's avatar
Jim Blandy committed
689
  face = FRAME_FACES (f) [XFASTINT (face_id)];
Jim Blandy's avatar
Jim Blandy committed
690 691 692

  if (EQ (attr_name, intern ("font")))
    {
Jim Blandy's avatar
Jim Blandy committed
693
      XFontStruct *font = load_font (f, attr_value);
Jim Blandy's avatar
Jim Blandy committed
694 695 696 697 698
      unload_font (f, face->font);
      face->font = font;
    }
  else if (EQ (attr_name, intern ("foreground")))
    {
Jim Blandy's avatar
Jim Blandy committed
699
      unsigned long new_color = load_color (f, attr_value);
Jim Blandy's avatar
Jim Blandy committed
700 701 702 703 704
      unload_color (f, face->foreground);
      face->foreground = new_color;
    }
  else if (EQ (attr_name, intern ("background")))
    {
Jim Blandy's avatar
Jim Blandy committed
705
      unsigned long new_color = load_color (f, attr_value);
Jim Blandy's avatar
Jim Blandy committed
706 707 708 709 710 711 712 713
      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
714 715 716 717
      unload_pixmap (f, face->stipple);
      if (NILP (attr_value))
	new_pixmap = 0;
      face->stipple = new_pixmap;
Jim Blandy's avatar
Jim Blandy committed
718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733
      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
734 735 736
      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
737 738 739 740 741 742
      UNBLOCK_INPUT;
    }

  if (id == 1)
    {
      BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
743 744 745
      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
746 747 748 749 750 751 752 753 754 755 756 757
      UNBLOCK_INPUT;
    }

  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
758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776

/* 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));
  CHECK_VECTOR (tem, 0);
  tem = XVECTOR (tem)->contents[2];
  CHECK_NUMBER (tem, 0);
  return XINT (tem);
}
Jim Blandy's avatar
Jim Blandy committed
777 778

void
Jim Blandy's avatar
Jim Blandy committed
779
syms_of_xfaces ()
Jim Blandy's avatar
Jim Blandy committed
780
{
Jim Blandy's avatar
Jim Blandy committed
781 782 783 784 785 786 787
  Qwindow = intern ("window");
  staticpro (&Qwindow);
  Qface = intern ("face");
  staticpro (&Qface);
  Qpriority = intern ("priority");
  staticpro (&Qpriority);

Jim Blandy's avatar
Jim Blandy committed
788 789 790 791 792 793
  defsubr (&Sframe_face_alist);
  defsubr (&Sset_frame_face_alist);
  defsubr (&Smake_face_internal);
  defsubr (&Sset_face_attribute_internal);
  defsubr (&Sinternal_next_face_id);
}