code.delx.au - gnu-emacs/blob - src/xfaces.c

   1 /* "Face" primitives.
   2    Copyright (C) 1992, 1993 Free Software Foundation.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20 /* This is derived from work by Lucid (some parts very loosely so).  */
  21
  22 #include <sys/types.h>
  23 #include <sys/stat.h>
  24
  25 #include "config.h"
  26 #include "lisp.h"
  27
  28 #ifdef HAVE_X_WINDOWS
  29
  30 #include "xterm.h"
  31 #include "buffer.h"
  32 #include "dispextern.h"
  33 #include "frame.h"
  34 #include "blockinput.h"
  35 /* #include "window.h" */
  36
  37 /* Display Context for the icons */
  38 #include <X11/Intrinsic.h>
  39 #include <X11/StringDefs.h>
  40 /* #include <X11/Xmu/Drawing.h> */  /* Appears not to be used */
  41 #include <X11/Xos.h>
  42
  43 \f
  44 /* An explanation of the face data structures.  */
  45
  46 /* ========================= Face Data Structures =========================
  47
  48    All lisp code uses symbols as face names.
  49
  50    Each frame has a face_alist member (with the frame-face-alist and
  51    set-frame-face-alist accessors), associating the face names with
  52    vectors of the form
  53        [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE-P]
  54    where
  55        face is the symbol `face',
  56        NAME is the symbol with which this vector is associated (a backpointer),
  57        ID is the face ID, an integer used internally by the C code to identify
  58            the face,
  59        FONT, FOREGROUND, and BACKGROUND are strings naming the fonts and colors
  60            to use with the face,
  61        BACKGROUND-PIXMAP is the name of an x bitmap filename, which we don't
  62            use right now, and
  63        UNDERLINE-P is non-nil if the face should be underlined.
  64    (lisp/faces.el maintains these association lists.)
  65
  66    The frames' private alists hold the frame-local definitions for the
  67    faces.  The lisp variable global-face-data contains the global
  68    defaults for faces.  (See lisp/faces.el for this too.)
  69
  70    In the C code, we also have a `struct face' with the elements
  71       `foreground', `background', `font', and `underline',
  72    which specify its visual appearance, and elements
  73       `gc' and `cached_index';
  74    `gc' may be an X GC which has been built for the given display
  75    parameters.  Faces with GC's are called `display faces'.  Whether
  76    or not a face has a GC depends on what data structure the face is
  77    in; we explain these more below.  (See src/dispextern.h.)
  78
  79    Each frame also has members called `faces' and `n_faces' (with the
  80    accessors FRAME_FACES and FRAME_N_FACES), which define an array of
  81    struct face pointers, indexed by face ID (element 2 of the
  82    vector).  These are called "frame faces".
  83       Element 0 is the default face --- the one used for normal text.
  84       Element 1 is the modeline face.
  85    These faces have their GC's set; the rest do not.  (See src/xterm.h.)
  86
  87    The global variables `face_vector' and `nfaces' define another
  88    array of struct face pointers, with their GC's set.  This array
  89    acts as a cache of GC's to be used by all frames.  The function
  90    `intern_face', passed a struct face *, searches face_vector for a
  91    struct face with the same parameters, adds a new one with a GC if
  92    it doesn't find one, and returns it.  If you have a `struct face',
  93    and you want a GC for it, call intern_face on that struct, and it
  94    will return a `struct face *' with its GC set.  The faces in
  95    face_vector are called `cached faces.' (See src/xfaces.c.)
  96
  97    The `GLYPH' data type is an unsigned integer type; the bottom byte
  98    is a character code, and the byte above that is a face id.  The
  99    `struct frame_glyphs' structure, used to describe frames' current
 100    or desired contents, is essentially a matrix of GLYPHs; the face
 101    ID's in a struct frame_glyphs are indices into FRAME_FACES.  (See
 102    src/dispextern.h.)
 103
 104    Some subtleties:
 105
 106    Since face_vector is just a cache --- there are no pointers into it
 107    from the rest of the code, and everyone accesses it through
 108    intern_face --- we could just free its GC's and throw the whole
 109    thing away without breaking anything.  This gives us a simple way
 110    to garbage-collect old GC's nobody's using any more - we can just
 111    purge face_vector, and then let subsequent calls to intern_face
 112    refill it as needed.  The function clear_face_vector performs this
 113    purge.
 114
 115    We're often applying intern_face to faces in frames' local arrays -
 116    for example, we do this while sending GLYPHs from a struct
 117    frame_glyphs to X during redisplay.  It would be nice to avoid
 118    searching all of face_vector every time we intern a frame's face.
 119    So, when intern_face finds a match for FACE in face_vector, it
 120    stores the index of the match in FACE's cached_index member, and
 121    checks there first next time.  */
 122
 123 \f
 124 /* Definitions and declarations.  */
 125
 126 /* A table of display faces.  */
 127 struct face **face_vector;
 128 /* The length in use of the table.  */
 129 int nfaces;
 130 /* The allocated length of the table.   */
 131 int nfaces_allocated;
 132
 133 /* The number of face-id's in use (same for all frames).  */
 134 int next_face_id;
 135
 136 #define FACE_DEFAULT (~0)
 137
 138 Lisp_Object Qface, Qwindow, Qpriority;
 139
 140 static void build_face ();
 141 static Lisp_Object face_name_id_number ();
 142
 143 struct face *intern_face ();
 144 static void ensure_face_ready ();
 145 \f
 146 /* Allocating, copying, and comparing struct faces.  */
 147
 148 /* Allocate a new face */
 149 static struct face *
 150 allocate_face ()
 151 {
 152   struct face *result = (struct face *) xmalloc (sizeof (struct face));
 153   bzero (result, sizeof (struct face));
 154   result->font = (XFontStruct *) FACE_DEFAULT;
 155   result->foreground = FACE_DEFAULT;
 156   result->background = FACE_DEFAULT;
 157   result->stipple = FACE_DEFAULT;
 158   return result;
 159 }
 160
 161 /* Make a new face that's a copy of an existing one.  */
 162 static struct face *
 163 copy_face (face)
 164      struct face *face;
 165 {
 166   struct face *result = allocate_face ();
 167
 168   result->font = face->font;
 169   result->foreground = face->foreground;
 170   result->background = face->background;
 171   result->stipple = face->stipple;
 172   result->underline = face->underline;
 173
 174   return result;
 175 }
 176
 177 static int
 178 face_eql (face1, face2)
 179      struct face *face1, *face2;
 180 {
 181   return (   face1->font       == face2->font
 182           && face1->foreground == face2->foreground
 183           && face1->background == face2->background
 184           && face1->stipple    == face2->stipple
 185           && face1->underline  == face2->underline);
 186 }
 187 \f
 188 /* Interning faces in the `face_vector' cache, and clearing that cache.  */
 189
 190 /* Return the unique display face corresponding to the user-level face FACE.
 191    If there isn't one, make one, and find a slot in the face_vector to
 192    put it in.  */
 193 static struct face *
 194 get_cached_face (f, face)
 195      struct frame *f;
 196      struct face *face;
 197 {
 198   int i, empty = -1;
 199   struct face *result;
 200
 201   /* Perhaps FACE->cached_index is valid; this could happen if FACE is
 202      in a frame's face list.  */
 203   if (face->cached_index >= 0
 204       && face->cached_index < nfaces
 205       && face_eql (face_vector[face->cached_index], face))
 206     return face_vector[face->cached_index];
 207
 208   /* Look for an existing display face that does the job.
 209      Also find an empty slot if any.   */
 210   for (i = 0; i < nfaces; i++)
 211     {
 212       if (face_eql (face_vector[i], face))
 213         return face_vector[i];
 214       if (face_vector[i] == 0)
 215         empty = i;
 216     }
 217
 218   /* If no empty slots, make one.  */
 219   if (empty < 0 && nfaces == nfaces_allocated)
 220     {
 221       int newsize = nfaces + 20;
 222       face_vector
 223         = (struct face **) xrealloc (face_vector,
 224                                      newsize * sizeof (struct face *));
 225       nfaces_allocated = newsize;
 226     }
 227
 228   if (empty < 0)
 229     empty = nfaces++;
 230
 231   /* Put a new display face in the empty slot.  */
 232   result = copy_face (face);
 233   face_vector[empty] = result;
 234
 235   /* Make a graphics context for it.  */
 236   build_face (f, result);
 237
 238   return result;
 239 }
 240
 241 /* Given a frame face, return an equivalent display face
 242    (one which has a graphics context).  */
 243
 244 struct face *
 245 intern_face (f, face)
 246      struct frame *f;
 247      struct face *face;
 248 {
 249   struct face *result;
 250
 251   /* Does the face have a GC already?  */
 252   if (face->gc)
 253     return face;
 254
 255   /* If it's equivalent to the default face, use that.  */
 256   if (face_eql (face, FRAME_DEFAULT_FACE (f)))
 257     {
 258       if (!FRAME_DEFAULT_FACE (f)->gc)
 259         build_face (f, FRAME_DEFAULT_FACE (f));
 260       return FRAME_DEFAULT_FACE (f);
 261     }
 262
 263   /* If it's equivalent to the mode line face, use that.  */
 264   if (face_eql (face, FRAME_MODE_LINE_FACE (f)))
 265     {
 266       if (!FRAME_MODE_LINE_FACE (f)->gc)
 267         build_face (f, FRAME_MODE_LINE_FACE (f));
 268       return FRAME_MODE_LINE_FACE (f);
 269     }
 270
 271   /* Get a specialized display face.  */
 272   return get_cached_face (f, face);
 273 }
 274
 275 /* Clear out face_vector and start anew.
 276    This should be done from time to time just to avoid
 277    keeping too many graphics contexts in face_vector
 278    that are no longer needed.  */
 279
 280 void
 281 clear_face_vector ()
 282 {
 283   Lisp_Object rest;
 284   Display *dpy = x_current_display;
 285   int i;
 286
 287   BLOCK_INPUT;
 288   /* Free the display faces in the face_vector.  */
 289   for (i = 0; i < nfaces; i++)
 290     {
 291       struct face *face = face_vector[i];
 292       if (face->gc)
 293         XFreeGC (dpy, face->gc);
 294       xfree (face);
 295     }
 296   nfaces = 0;
 297
 298   UNBLOCK_INPUT;
 299 }
 300 \f
 301 /* Allocating and freeing X resources for display faces.  */
 302
 303 /* Make a graphics context for face FACE, which is on frame F,
 304    if that can be done.  */
 305 static void
 306 build_face (f, face)
 307      struct frame *f;
 308      struct face *face;
 309 {
 310   GC gc;
 311   XGCValues xgcv;
 312   unsigned long mask;
 313
 314   if (face->foreground != FACE_DEFAULT)
 315     xgcv.foreground = face->foreground;
 316   else
 317     xgcv. foreground = f->display.x->foreground_pixel;
 318   if (face->background != FACE_DEFAULT)
 319     xgcv.background = face->background;
 320   else
 321     xgcv. background = f->display.x->background_pixel;
 322   if (face->font && (int) face->font != FACE_DEFAULT)
 323     xgcv.font = face->font->fid;
 324   else
 325     xgcv.font = f->display.x->font->fid;
 326   xgcv.graphics_exposures = 0;
 327   mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
 328   gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
 329                   mask, &xgcv);
 330 #if 0
 331   if (face->stipple && face->stipple != FACE_DEFAULT)
 332     XSetStipple (x_current_display, gc, face->stipple);
 333 #endif
 334   face->gc = gc;
 335 }
 336
 337 /* Allocating, freeing, and duplicating fonts, colors, and pixmaps.  */
 338
 339 static XFontStruct *
 340 load_font (f, name)
 341      struct frame *f;
 342      Lisp_Object name;
 343 {
 344   XFontStruct *font;
 345
 346   if (NILP (name))
 347     return (XFontStruct *) FACE_DEFAULT;
 348
 349   CHECK_STRING (name, 0);
 350   BLOCK_INPUT;
 351   font = XLoadQueryFont (x_current_display, (char *) XSTRING (name)->data);
 352   UNBLOCK_INPUT;
 353
 354   if (! font)
 355     Fsignal (Qerror, Fcons (build_string ("undefined font"),
 356                             Fcons (name, Qnil)));
 357   return font;
 358 }
 359
 360 static void
 361 unload_font (f, font)
 362      struct frame *f;
 363      XFontStruct *font;
 364 {
 365   if (!font || font == ((XFontStruct *) FACE_DEFAULT))
 366     return;
 367   XFreeFont (x_current_display, font);
 368 }
 369
 370 static unsigned long
 371 load_color (f, name)
 372      struct frame *f;
 373      Lisp_Object name;
 374 {
 375   Display *dpy = x_current_display;
 376   Colormap cmap;
 377   XColor color;
 378   int result;
 379
 380   if (NILP (name))
 381     return FACE_DEFAULT;
 382
 383   cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
 384
 385   CHECK_STRING (name, 0);
 386   BLOCK_INPUT;
 387   result = XParseColor (dpy, cmap, (char *) XSTRING (name)->data, &color);
 388   UNBLOCK_INPUT;
 389   if (! result)
 390     Fsignal (Qerror, Fcons (build_string ("undefined color"),
 391                             Fcons (name, Qnil)));
 392   BLOCK_INPUT;
 393   result = XAllocColor (dpy, cmap, &color);
 394   UNBLOCK_INPUT;
 395   if (! result)
 396     Fsignal (Qerror, Fcons (build_string ("X server cannot allocate color"),
 397                             Fcons (name, Qnil)));
 398   return (unsigned long) color.pixel;
 399 }
 400
 401 static void
 402 unload_color (f, pixel)
 403      struct frame *f;
 404      Pixel pixel;
 405 {
 406   Colormap cmap;
 407   Display *dpy = x_current_display;
 408   if (pixel == FACE_DEFAULT)
 409     return;
 410   cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
 411   BLOCK_INPUT;
 412   XFreeColors (dpy, cmap, &pixel, 1, 0);
 413   UNBLOCK_INPUT;
 414 }
 415 \f
 416 /* Initializing face arrays for frames. */
 417
 418 /* Set up faces 0 and 1 based on the normal text and modeline GC's.  */
 419 void
 420 init_frame_faces (f)
 421      struct frame *f;
 422 {
 423   ensure_face_ready (f, 0);
 424   {
 425     XGCValues gcv;
 426     struct face *face = FRAME_FACES (f) [0];
 427
 428     XGetGCValues (x_current_display, f->display.x->normal_gc,
 429                   GCForeground | GCBackground | GCFont, &gcv);
 430     face->gc         = f->display.x->normal_gc;
 431     face->foreground = gcv.foreground;
 432     face->background = gcv.background;
 433     face->font       = XQueryFont (x_current_display, gcv.font);
 434     face->stipple = 0;
 435     face->underline = 0;
 436   }
 437
 438   ensure_face_ready (f, 1);
 439   {
 440     XGCValues gcv;
 441     struct face *face = FRAME_FACES (f) [1];
 442
 443     XGetGCValues (x_current_display, f->display.x->reverse_gc,
 444                   GCForeground | GCBackground | GCFont, &gcv);
 445     face->gc         = f->display.x->reverse_gc;
 446     face->foreground = gcv.foreground;
 447     face->background = gcv.background;
 448     face->font       = XQueryFont (x_current_display, gcv.font);
 449     face->stipple = 0;
 450     face->underline = 0;
 451   }
 452 }
 453
 454 #if 0
 455 void
 456 init_frame_faces (f)
 457      struct frame *f;
 458 {
 459   struct frame *other_frame = 0;
 460   Lisp_Object rest;
 461
 462   for (rest = Vframe_list; !NILP (rest); rest = Fcdr (rest))
 463     {
 464       struct frame *f2 = XFRAME (Fcar (rest));
 465       if (f2 != f && FRAME_X_P (f2))
 466         {
 467           other_frame = f2;
 468           break;
 469         }
 470     }
 471
 472   if (other_frame)
 473     {
 474       /* Make sure this frame's face vector is as big as the others.  */
 475       FRAME_N_FACES (f) = FRAME_N_FACES (other_frame);
 476       FRAME_FACES (f)
 477         = (struct face **) xmalloc (FRAME_N_FACES (f) * sizeof (struct face *));
 478
 479       /* Make sure the frame has the two basic faces.  */
 480       FRAME_DEFAULT_FACE (f)
 481         = copy_face (FRAME_DEFAULT_FACE (other_frame));
 482       FRAME_MODE_LINE_FACE (f)
 483         = copy_face (FRAME_MODE_LINE_FACE (other_frame));
 484     }
 485 }
 486 #endif
 487
 488
 489 /* Called from Fdelete_frame.  */
 490 void
 491 free_frame_faces (f)
 492      struct frame *f;
 493 {
 494   Display *dpy = x_current_display;
 495   int i;
 496
 497   for (i = 0; i < FRAME_N_FACES (f); i++)
 498     {
 499       struct face *face = FRAME_FACES (f) [i];
 500       if (! face)
 501         continue;
 502       if (face->gc)
 503         XFreeGC (dpy, face->gc);
 504       unload_font (f, face->font);
 505       unload_color (f, face->foreground);
 506       unload_color (f, face->background);
 507 #if 0
 508       unload_pixmap (f, face->stipple);
 509 #endif
 510       xfree (face);
 511     }
 512   xfree (FRAME_FACES (f));
 513   FRAME_FACES (f) = 0;
 514   FRAME_N_FACES (f) = 0;
 515 }
 516 \f
 517 /* Interning faces in a frame's face array.  */
 518
 519 /* Find a match for NEW_FACE in a FRAME's face array, and add it if we don't
 520    find one.  */
 521 int
 522 intern_frame_face (new_face, frame)
 523      struct face *new_face;
 524      struct frame *frame;
 525 {
 526   int len = FRAME_N_FACES (frame);
 527   int i;
 528
 529   /* Search for a face already on FRAME equivalent to FACE.  */
 530   for (i = 0; i < len; i++)
 531     {
 532       struct face *frame_face = FRAME_FACES (frame)[i];
 533
 534       if (frame_face && face_eql (new_face, frame_face))
 535         return i;
 536     }
 537
 538   /* We didn't find one; add a new one.  */
 539   i = next_face_id++;
 540
 541   ensure_face_ready (frame, i);
 542   bcopy (new_face, FRAME_FACES (frame)[i], sizeof (new_face));
 543
 544   return i;
 545 }
 546
 547 /* Make face id ID valid on frame F.  */
 548
 549 static void
 550 ensure_face_ready (f, id)
 551      struct frame *f;
 552      int id;
 553 {
 554   if (FRAME_N_FACES (f) <= id)
 555     {
 556       int n = id + 10;
 557       int i;
 558       if (!FRAME_N_FACES (f))
 559         FRAME_FACES (f)
 560           = (struct face **) xmalloc (sizeof (struct face *) * n);
 561       else
 562         FRAME_FACES (f)
 563           = (struct face **) xrealloc (FRAME_FACES (f),
 564                                        sizeof (struct face *) * n);
 565
 566       bzero (FRAME_FACES (f) + FRAME_N_FACES (f),
 567              (n - FRAME_N_FACES (f)) * sizeof (struct face *));
 568       FRAME_N_FACES (f) = n;
 569     }
 570
 571   if (FRAME_FACES (f) [id] == 0)
 572     FRAME_FACES (f) [id] = allocate_face ();
 573 }
 574 \f
 575 /* Computing faces appropriate for a given piece of text in a buffer.  */
 576
 577 /* Modify face TO by copying from FROM all properties which have
 578    nondefault settings.  */
 579 static void
 580 merge_faces (from, to)
 581      struct face *from, *to;
 582 {
 583   if (from->font != (XFontStruct *)FACE_DEFAULT)
 584     {
 585       to->font = from->font;
 586     }
 587   if (from->foreground != FACE_DEFAULT)
 588     to->foreground = from->foreground;
 589   if (from->background != FACE_DEFAULT)
 590     to->background = from->background;
 591   if (from->stipple != FACE_DEFAULT)
 592     to->stipple = from->stipple;
 593   if (from->underline)
 594     to->underline = from->underline;
 595 }
 596
 597 struct sortvec
 598 {
 599   Lisp_Object overlay;
 600   int beg, end;
 601   int priority;
 602 };
 603
 604 static int
 605 sort_overlays (s1, s2)
 606      struct sortvec *s1, *s2;
 607 {
 608   if (s1->priority != s2->priority)
 609     return s1->priority - s2->priority;
 610   if (s1->beg != s2->beg)
 611     return s1->beg - s2->beg;
 612   if (s1->end != s2->end)
 613     return s2->end - s1->end;
 614   return 0;
 615 }
 616
 617 /* Return the face ID associated with a buffer position POS.
 618    Store into *ENDPTR the position at which a different face is needed.
 619    This does not take account of glyphs that specify their own face codes.
 620    F is the frame in use for display, and W is the window.  */
 621 int
 622 compute_char_face (f, w, pos, endptr)
 623      struct frame *f;
 624      struct window *w;
 625      int pos;
 626      int *endptr;
 627 {
 628   struct face face;
 629   Lisp_Object prop, position, length;
 630   Lisp_Object overlay, start, end;
 631   int i, j, noverlays;
 632   int facecode;
 633   int endpos;
 634   Lisp_Object *overlay_vec;
 635   int len;
 636   struct sortvec *sortvec;
 637   Lisp_Object frame;
 638
 639   XSET (frame, Lisp_Frame, f);
 640
 641   XFASTINT (position) = pos;
 642   prop = Fget_text_property (position, Qface);
 643
 644   len = 10;
 645   overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
 646   noverlays = overlays_at (pos, &overlay_vec, &len, &endpos);
 647
 648   /* Optimize the default case.  */
 649   if (noverlays == 0 && NILP (prop))
 650     return 0;
 651
 652   bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (struct face));
 653
 654   if (!NILP (prop))
 655     {
 656       facecode = face_name_id_number (frame, prop);
 657       if (facecode >= 0 && facecode < FRAME_N_FACES (f)
 658           && FRAME_FACES (f) [facecode] != 0)
 659         merge_faces (FRAME_FACES (f) [facecode], &face);
 660     }
 661
 662   /* Put the valid and relevant overlays into sortvec.  */
 663   sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
 664
 665   for (i = 0, j = 0; i < noverlays; i++)
 666     {
 667       overlay = overlay_vec[i];
 668
 669       if (OVERLAY_VALID (overlay)
 670           && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
 671           && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
 672         {
 673           Lisp_Object window;
 674           window = Foverlay_get (overlay, Qwindow);
 675
 676           /* Also ignore overlays limited to one window
 677              if it's not the window we are using.  */
 678           if (NILP (window) || XWINDOW (window) == w)
 679             {
 680               Lisp_Object tem;
 681
 682               /* This overlay is good and counts:
 683                  put it in sortvec.  */
 684               sortvec[j].overlay = overlay;
 685               sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
 686               sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
 687               tem = Foverlay_get (overlay, Qpriority);
 688               if (INTEGERP (tem))
 689                 sortvec[j].priority = XINT (tem);
 690               else
 691                 sortvec[j].priority = 0;
 692               j++;
 693             }
 694         }
 695     }
 696   noverlays = j;
 697
 698   /* Sort the overlays into the proper order: increasing priority.  */
 699
 700   qsort (sortvec, noverlays, sizeof (struct sortvec), sort_overlays);
 701
 702   /* Now merge the overlay data in that order.  */
 703
 704   for (i = 0; i < noverlays; i++)
 705     {
 706       prop = Foverlay_get (overlay_vec[i], Qface);
 707       if (!NILP (prop))
 708         {
 709           Lisp_Object oend;
 710           int oendpos;
 711
 712           facecode = face_name_id_number (frame, prop);
 713           if (facecode >= 0 && facecode < FRAME_N_FACES (f)
 714               && FRAME_FACES (f) [facecode] != 0)
 715             merge_faces (FRAME_FACES (f) [facecode], &face);
 716
 717           oend = OVERLAY_END (overlay_vec[i]);
 718           oendpos = OVERLAY_POSITION (oend);
 719           if (oendpos > endpos)
 720             endpos = oendpos;
 721         }
 722     }
 723
 724   xfree (overlay_vec);
 725
 726   *endptr = endpos;
 727
 728   return intern_frame_face (f, &face);
 729 }
 730
 731 /* Return the face ID to use to display a special glyph which selects
 732    FACE_CODE as the face ID, assuming that ordinarily the face would
 733    be BASIC_FACE.  F is the frame.  */
 734 int
 735 compute_glyph_face (f, face_code)
 736      struct frame *f;
 737      int face_code;
 738 {
 739   struct face face;
 740
 741   bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (face));
 742
 743   if (face_code >= 0 && face_code < FRAME_N_FACES (f)
 744       && FRAME_FACES (f) [face_code] != 0)
 745     merge_faces (FRAME_FACES (f) [face_code], &face);
 746
 747   return intern_frame_face (f, &face);
 748 }
 749 \f
 750 /* Lisp interface. */
 751
 752 DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0,
 753        "")
 754      (frame)
 755      Lisp_Object frame;
 756 {
 757   CHECK_FRAME (frame, 0);
 758   return XFRAME (frame)->face_alist;
 759 }
 760
 761 DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist,
 762        2, 2, 0, "")
 763      (frame, value)
 764      Lisp_Object frame, value;
 765 {
 766   CHECK_FRAME (frame, 0);
 767   XFRAME (frame)->face_alist = value;
 768   return value;
 769 }
 770
 771
 772 DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0,
 773   "Create face number FACE-ID on all frames.")
 774   (face_id)
 775      Lisp_Object face_id;
 776 {
 777   Lisp_Object rest;
 778   int id = XINT (face_id);
 779
 780   CHECK_NUMBER (face_id, 0);
 781   if (id < 0 || id >= next_face_id)
 782     error ("Face id out of range");
 783
 784   for (rest = Vframe_list; !NILP (rest); rest = XCONS (rest)->cdr)
 785     {
 786       struct frame *f = XFRAME (XCONS (rest)->car);
 787       if (FRAME_X_P (f))
 788         ensure_face_ready (f, id);
 789     }
 790   return Qnil;
 791 }
 792
 793
 794 DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal,
 795        Sset_face_attribute_internal, 4, 4, 0, "")
 796      (face_id, attr_name, attr_value, frame)
 797      Lisp_Object face_id, attr_name, attr_value, frame;
 798 {
 799   struct face *face;
 800   struct frame *f;
 801   int magic_p;
 802   int id;
 803
 804   CHECK_FRAME (frame, 0);
 805   CHECK_NUMBER (face_id, 0);
 806   CHECK_SYMBOL (attr_name, 0);
 807
 808   f = XFRAME (frame);
 809   id = XINT (face_id);
 810   if (id < 0 || id >= next_face_id)
 811     error ("Face id out of range");
 812
 813   ensure_face_ready (f, id);
 814   face = FRAME_FACES (f) [XFASTINT (face_id)];
 815
 816   if (EQ (attr_name, intern ("font")))
 817     {
 818       XFontStruct *font = load_font (f, attr_value);
 819       unload_font (f, face->font);
 820       face->font = font;
 821     }
 822   else if (EQ (attr_name, intern ("foreground")))
 823     {
 824       unsigned long new_color = load_color (f, attr_value);
 825       unload_color (f, face->foreground);
 826       face->foreground = new_color;
 827     }
 828   else if (EQ (attr_name, intern ("background")))
 829     {
 830       unsigned long new_color = load_color (f, attr_value);
 831       unload_color (f, face->background);
 832       face->background = new_color;
 833     }
 834 #if 0
 835   else if (EQ (attr_name, intern ("background-pixmap")))
 836     {
 837       unsigned int w, h, d;
 838       unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h, &d, 0);
 839       unload_pixmap (f, face->stipple);
 840       if (NILP (attr_value))
 841         new_pixmap = 0;
 842       face->stipple = new_pixmap;
 843       face->pixmap_w = w;
 844       face->pixmap_h = h;
 845 /*      face->pixmap_depth = d; */
 846     }
 847 #endif /* 0 */
 848   else if (EQ (attr_name, intern ("underline")))
 849     {
 850       int new = !NILP (attr_value);
 851       face->underline = new;
 852     }
 853   else
 854     error ("unknown face attribute");
 855
 856   if (id == 0)
 857     {
 858       BLOCK_INPUT;
 859       if (FRAME_DEFAULT_FACE (f)->gc != 0)
 860         XFreeGC (x_current_display, FRAME_DEFAULT_FACE (f)->gc);
 861       build_face (f, FRAME_DEFAULT_FACE (f));
 862       UNBLOCK_INPUT;
 863     }
 864
 865   if (id == 1)
 866     {
 867       BLOCK_INPUT;
 868       if (FRAME_MODE_LINE_FACE (f)->gc != 0)
 869         XFreeGC (x_current_display, FRAME_MODE_LINE_FACE (f)->gc);
 870       build_face (f, FRAME_MODE_LINE_FACE (f));
 871       UNBLOCK_INPUT;
 872     }
 873
 874   return Qnil;
 875 }
 876
 877 DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id,
 878   0, 0, 0, "")
 879   ()
 880 {
 881   return make_number (next_face_id++);
 882 }
 883
 884 /* Return the face id for name NAME on frame FRAME.
 885    (It should be the same for all frames,
 886    but it's as easy to use the "right" frame to look it up
 887    as to use any other one.)  */
 888
 889 static Lisp_Object
 890 face_name_id_number (frame, name)
 891      Lisp_Object frame, name;
 892 {
 893   Lisp_Object tem;
 894
 895   CHECK_FRAME (frame, 0);
 896   tem = Fcdr (Fassq (name, XFRAME (frame)->face_alist));
 897   CHECK_VECTOR (tem, 0);
 898   tem = XVECTOR (tem)->contents[2];
 899   CHECK_NUMBER (tem, 0);
 900   return XINT (tem);
 901 }
 902 \f
 903 /* Emacs initialization.  */
 904
 905 void
 906 syms_of_xfaces ()
 907 {
 908   Qwindow = intern ("window");
 909   staticpro (&Qwindow);
 910   Qface = intern ("face");
 911   staticpro (&Qface);
 912   Qpriority = intern ("priority");
 913   staticpro (&Qpriority);
 914
 915   defsubr (&Sframe_face_alist);
 916   defsubr (&Sset_frame_face_alist);
 917   defsubr (&Smake_face_internal);
 918   defsubr (&Sset_face_attribute_internal);
 919   defsubr (&Sinternal_next_face_id);
 920 }
 921
 922 #endif /* HAVE_X_WINDOWS */
 923