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   /* If it's equivalent to the default face, use that.  */
 250   if (face_eql (face, FRAME_DEFAULT_FACE (f)))
 251     {
 252       if (!FRAME_DEFAULT_FACE (f)->gc)
 253         build_face (f, FRAME_DEFAULT_FACE (f));
 254       return FRAME_DEFAULT_FACE (f);
 255     }
 256
 257   /* If it's equivalent to the mode line face, use that.  */
 258   if (face_eql (face, FRAME_MODE_LINE_FACE (f)))
 259     {
 260       if (!FRAME_MODE_LINE_FACE (f)->gc)
 261         build_face (f, FRAME_MODE_LINE_FACE (f));
 262       return FRAME_MODE_LINE_FACE (f);
 263     }
 264
 265   /* If it's not one of the frame's default faces, it shouldn't have a GC.  */
 266   if (face->gc)
 267     abort ();
 268
 269   /* Get a specialized display face.  */
 270   return get_cached_face (f, face);
 271 }
 272
 273 /* Clear out face_vector and start anew.
 274    This should be done from time to time just to avoid
 275    keeping too many graphics contexts in face_vector
 276    that are no longer needed.  */
 277
 278 void
 279 clear_face_vector ()
 280 {
 281   Lisp_Object rest;
 282   Display *dpy = x_current_display;
 283   int i;
 284
 285   BLOCK_INPUT;
 286   /* Free the display faces in the face_vector.  */
 287   for (i = 0; i < nfaces; i++)
 288     {
 289       struct face *face = face_vector[i];
 290       if (face->gc)
 291         XFreeGC (dpy, face->gc);
 292       xfree (face);
 293     }
 294   nfaces = 0;
 295
 296   UNBLOCK_INPUT;
 297 }
 298 \f
 299 /* Allocating and freeing X resources for display faces.  */
 300
 301 /* Make a graphics context for face FACE, which is on frame F,
 302    if that can be done.  */
 303 static void
 304 build_face (f, face)
 305      struct frame *f;
 306      struct face *face;
 307 {
 308   GC gc;
 309   XGCValues xgcv;
 310   unsigned long mask;
 311
 312   if (face->foreground != FACE_DEFAULT)
 313     xgcv.foreground = face->foreground;
 314   else
 315     xgcv. foreground = f->display.x->foreground_pixel;
 316   if (face->background != FACE_DEFAULT)
 317     xgcv.background = face->background;
 318   else
 319     xgcv. background = f->display.x->background_pixel;
 320   if (face->font && (int) face->font != FACE_DEFAULT)
 321     xgcv.font = face->font->fid;
 322   else
 323     xgcv.font = f->display.x->font->fid;
 324   xgcv.graphics_exposures = 0;
 325   mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
 326   gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
 327                   mask, &xgcv);
 328 #if 0
 329   if (face->stipple && face->stipple != FACE_DEFAULT)
 330     XSetStipple (x_current_display, gc, face->stipple);
 331 #endif
 332   face->gc = gc;
 333 }
 334
 335 /* Allocating, freeing, and duplicating fonts, colors, and pixmaps.  */
 336
 337 static XFontStruct *
 338 load_font (f, name)
 339      struct frame *f;
 340      Lisp_Object name;
 341 {
 342   XFontStruct *font;
 343
 344   if (NILP (name))
 345     return (XFontStruct *) FACE_DEFAULT;
 346
 347   CHECK_STRING (name, 0);
 348   BLOCK_INPUT;
 349   font = XLoadQueryFont (x_current_display, (char *) XSTRING (name)->data);
 350   UNBLOCK_INPUT;
 351
 352   if (! font)
 353     Fsignal (Qerror, Fcons (build_string ("undefined font"),
 354                             Fcons (name, Qnil)));
 355   return font;
 356 }
 357
 358 static void
 359 unload_font (f, font)
 360      struct frame *f;
 361      XFontStruct *font;
 362 {
 363   if (!font || font == ((XFontStruct *) FACE_DEFAULT))
 364     return;
 365   XFreeFont (x_current_display, font);
 366 }
 367
 368 static unsigned long
 369 load_color (f, name)
 370      struct frame *f;
 371      Lisp_Object name;
 372 {
 373   Display *dpy = x_current_display;
 374   Colormap cmap;
 375   XColor color;
 376   int result;
 377
 378   if (NILP (name))
 379     return FACE_DEFAULT;
 380
 381   cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
 382
 383   CHECK_STRING (name, 0);
 384   BLOCK_INPUT;
 385   result = XParseColor (dpy, cmap, (char *) XSTRING (name)->data, &color);
 386   UNBLOCK_INPUT;
 387   if (! result)
 388     Fsignal (Qerror, Fcons (build_string ("undefined color"),
 389                             Fcons (name, Qnil)));
 390   BLOCK_INPUT;
 391   result = XAllocColor (dpy, cmap, &color);
 392   UNBLOCK_INPUT;
 393   if (! result)
 394     Fsignal (Qerror, Fcons (build_string ("X server cannot allocate color"),
 395                             Fcons (name, Qnil)));
 396   return (unsigned long) color.pixel;
 397 }
 398
 399 static void
 400 unload_color (f, pixel)
 401      struct frame *f;
 402      Pixel pixel;
 403 {
 404   Colormap cmap;
 405   Display *dpy = x_current_display;
 406   if (pixel == FACE_DEFAULT)
 407     return;
 408   cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
 409   BLOCK_INPUT;
 410   XFreeColors (dpy, cmap, &pixel, 1, 0);
 411   UNBLOCK_INPUT;
 412 }
 413 \f
 414 /* Initializing face arrays for frames. */
 415
 416 /* Set up faces 0 and 1 based on the normal text and modeline GC's.  */
 417 void
 418 init_frame_faces (f)
 419      struct frame *f;
 420 {
 421   ensure_face_ready (f, 0);
 422   {
 423     XGCValues gcv;
 424     struct face *face = FRAME_FACES (f) [0];
 425
 426     XGetGCValues (x_current_display, f->display.x->normal_gc,
 427                   GCForeground | GCBackground | GCFont, &gcv);
 428     face->gc         = f->display.x->normal_gc;
 429     face->foreground = gcv.foreground;
 430     face->background = gcv.background;
 431     face->font       = XQueryFont (x_current_display, gcv.font);
 432     face->stipple = 0;
 433     face->underline = 0;
 434   }
 435
 436   ensure_face_ready (f, 1);
 437   {
 438     XGCValues gcv;
 439     struct face *face = FRAME_FACES (f) [1];
 440
 441     XGetGCValues (x_current_display, f->display.x->reverse_gc,
 442                   GCForeground | GCBackground | GCFont, &gcv);
 443     face->gc         = f->display.x->reverse_gc;
 444     face->foreground = gcv.foreground;
 445     face->background = gcv.background;
 446     face->font       = XQueryFont (x_current_display, gcv.font);
 447     face->stipple = 0;
 448     face->underline = 0;
 449   }
 450 }
 451
 452 #if 0
 453 void
 454 init_frame_faces (f)
 455      struct frame *f;
 456 {
 457   struct frame *other_frame = 0;
 458   Lisp_Object rest;
 459
 460   for (rest = Vframe_list; !NILP (rest); rest = Fcdr (rest))
 461     {
 462       struct frame *f2 = XFRAME (Fcar (rest));
 463       if (f2 != f && FRAME_X_P (f2))
 464         {
 465           other_frame = f2;
 466           break;
 467         }
 468     }
 469
 470   if (other_frame)
 471     {
 472       /* Make sure this frame's face vector is as big as the others.  */
 473       FRAME_N_FACES (f) = FRAME_N_FACES (other_frame);
 474       FRAME_FACES (f)
 475         = (struct face **) xmalloc (FRAME_N_FACES (f) * sizeof (struct face *));
 476
 477       /* Make sure the frame has the two basic faces.  */
 478       FRAME_DEFAULT_FACE (f)
 479         = copy_face (FRAME_DEFAULT_FACE (other_frame));
 480       FRAME_MODE_LINE_FACE (f)
 481         = copy_face (FRAME_MODE_LINE_FACE (other_frame));
 482     }
 483 }
 484 #endif
 485
 486
 487 /* Called from Fdelete_frame.  */
 488 void
 489 free_frame_faces (f)
 490      struct frame *f;
 491 {
 492   Display *dpy = x_current_display;
 493   int i;
 494
 495   for (i = 0; i < FRAME_N_FACES (f); i++)
 496     {
 497       struct face *face = FRAME_FACES (f) [i];
 498       if (! face)
 499         continue;
 500       if (face->gc)
 501         XFreeGC (dpy, face->gc);
 502       unload_font (f, face->font);
 503       unload_color (f, face->foreground);
 504       unload_color (f, face->background);
 505 #if 0
 506       unload_pixmap (f, face->stipple);
 507 #endif
 508       xfree (face);
 509     }
 510   xfree (FRAME_FACES (f));
 511   FRAME_FACES (f) = 0;
 512   FRAME_N_FACES (f) = 0;
 513 }
 514 \f
 515 /* Interning faces in a frame's face array.  */
 516
 517 /* Find a match for NEW_FACE in a FRAME's face array, and add it if we don't
 518    find one.  */
 519 int
 520 intern_frame_face (frame, new_face)
 521      struct frame *frame;
 522      struct face *new_face;
 523 {
 524   int len = FRAME_N_FACES (frame);
 525   int i;
 526
 527   /* Search for a face already on FRAME equivalent to FACE.  */
 528   for (i = 0; i < len; i++)
 529     {
 530       struct face *frame_face = FRAME_FACES (frame)[i];
 531
 532       if (frame_face && face_eql (new_face, frame_face))
 533         return i;
 534     }
 535
 536   /* We didn't find one; add a new one.  */
 537   i = next_face_id++;
 538
 539   ensure_face_ready (frame, i);
 540   bcopy (new_face, FRAME_FACES (frame)[i], sizeof (*new_face));
 541
 542   return i;
 543 }
 544
 545 /* Make face id ID valid on frame F.  */
 546
 547 static void
 548 ensure_face_ready (f, id)
 549      struct frame *f;
 550      int id;
 551 {
 552   if (FRAME_N_FACES (f) <= id)
 553     {
 554       int n = id + 10;
 555       int i;
 556       if (!FRAME_N_FACES (f))
 557         FRAME_FACES (f)
 558           = (struct face **) xmalloc (sizeof (struct face *) * n);
 559       else
 560         FRAME_FACES (f)
 561           = (struct face **) xrealloc (FRAME_FACES (f),
 562                                        sizeof (struct face *) * n);
 563
 564       bzero (FRAME_FACES (f) + FRAME_N_FACES (f),
 565              (n - FRAME_N_FACES (f)) * sizeof (struct face *));
 566       FRAME_N_FACES (f) = n;
 567     }
 568
 569   if (FRAME_FACES (f) [id] == 0)
 570     FRAME_FACES (f) [id] = allocate_face ();
 571 }
 572 \f
 573 /* Computing faces appropriate for a given piece of text in a buffer.  */
 574
 575 /* Modify face TO by copying from FROM all properties which have
 576    nondefault settings.  */
 577 static void
 578 merge_faces (from, to)
 579      struct face *from, *to;
 580 {
 581   if (from->font != (XFontStruct *)FACE_DEFAULT)
 582     {
 583       to->font = from->font;
 584     }
 585   if (from->foreground != FACE_DEFAULT)
 586     to->foreground = from->foreground;
 587   if (from->background != FACE_DEFAULT)
 588     to->background = from->background;
 589   if (from->stipple != FACE_DEFAULT)
 590     to->stipple = from->stipple;
 591   if (from->underline)
 592     to->underline = from->underline;
 593 }
 594
 595 struct sortvec
 596 {
 597   Lisp_Object overlay;
 598   int beg, end;
 599   int priority;
 600 };
 601
 602 static int
 603 sort_overlays (s1, s2)
 604      struct sortvec *s1, *s2;
 605 {
 606   if (s1->priority != s2->priority)
 607     return s1->priority - s2->priority;
 608   if (s1->beg != s2->beg)
 609     return s1->beg - s2->beg;
 610   if (s1->end != s2->end)
 611     return s2->end - s1->end;
 612   return 0;
 613 }
 614
 615 /* Return the face ID associated with a buffer position POS.
 616    Store into *ENDPTR the position at which a different face is needed.
 617    This does not take account of glyphs that specify their own face codes.
 618    F is the frame in use for display, and W is a window displaying
 619    the current buffer.  */
 620 int
 621 compute_char_face (f, w, pos, endptr)
 622      struct frame *f;
 623      struct window *w;
 624      int pos;
 625      int *endptr;
 626 {
 627   struct face face;
 628   Lisp_Object prop, position;
 629   int i, j, noverlays;
 630   int facecode;
 631   Lisp_Object *overlay_vec;
 632   int len;
 633   struct sortvec *sortvec;
 634   Lisp_Object frame;
 635   int endpos;
 636
 637   /* W must display the current buffer.  We could write this function
 638      to use the frame and buffer of W, but right now it doesn't.  */
 639   if (XBUFFER (w->buffer) != current_buffer)
 640     abort ();
 641
 642   XSET (frame, Lisp_Frame, f);
 643
 644   endpos = ZV;
 645
 646   XFASTINT (position) = pos;
 647   prop = Fget_text_property (position, Qface, w->buffer);
 648   {
 649     Lisp_Object end;
 650
 651     end = Fnext_single_property_change (position, Qface, w->buffer);
 652     if (INTEGERP (end))
 653       endpos = XINT (end);
 654   }
 655
 656   {
 657     int next_overlay;
 658
 659     len = 10;
 660     overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
 661     noverlays = overlays_at (pos, &overlay_vec, &len, &next_overlay);
 662     if (next_overlay < endpos)
 663       endpos = next_overlay;
 664   }
 665
 666   *endptr = endpos;
 667
 668   /* Optimize the default case.  */
 669   if (noverlays == 0 && NILP (prop))
 670     return 0;
 671
 672   bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (struct face));
 673   face.gc = 0;
 674
 675   if (!NILP (prop))
 676     {
 677       facecode = face_name_id_number (frame, prop);
 678       if (facecode >= 0 && facecode < FRAME_N_FACES (f)
 679           && FRAME_FACES (f) [facecode] != 0)
 680         merge_faces (FRAME_FACES (f) [facecode], &face);
 681     }
 682
 683   /* Put the valid and relevant overlays into sortvec.  */
 684   sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
 685
 686   for (i = 0, j = 0; i < noverlays; i++)
 687     {
 688       Lisp_Object overlay = overlay_vec[i];
 689
 690       if (OVERLAY_VALID (overlay)
 691           && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
 692           && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
 693         {
 694           Lisp_Object window;
 695           window = Foverlay_get (overlay, Qwindow);
 696
 697           /* Also ignore overlays limited to one window
 698              if it's not the window we are using.  */
 699           if (XTYPE (window) != Lisp_Window
 700               || XWINDOW (window) == w)
 701             {
 702               Lisp_Object tem;
 703
 704               /* This overlay is good and counts:
 705                  put it in sortvec.  */
 706               sortvec[j].overlay = overlay;
 707               sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
 708               sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
 709               tem = Foverlay_get (overlay, Qpriority);
 710               if (INTEGERP (tem))
 711                 sortvec[j].priority = XINT (tem);
 712               else
 713                 sortvec[j].priority = 0;
 714               j++;
 715             }
 716         }
 717     }
 718   noverlays = j;
 719
 720   /* Sort the overlays into the proper order: increasing priority.  */
 721
 722   qsort (sortvec, noverlays, sizeof (struct sortvec), sort_overlays);
 723
 724   /* Now merge the overlay data in that order.  */
 725   for (i = 0; i < noverlays; i++)
 726     {
 727       prop = Foverlay_get (sortvec[i].overlay, Qface);
 728       if (!NILP (prop))
 729         {
 730           Lisp_Object oend;
 731           int oendpos;
 732
 733           facecode = face_name_id_number (frame, prop);
 734           if (facecode >= 0 && facecode < FRAME_N_FACES (f)
 735               && FRAME_FACES (f) [facecode] != 0)
 736             merge_faces (FRAME_FACES (f) [facecode], &face);
 737
 738           oend = OVERLAY_END (sortvec[i].overlay);
 739           oendpos = OVERLAY_POSITION (oend);
 740           if (oendpos < endpos)
 741             endpos = oendpos;
 742         }
 743     }
 744
 745   xfree (overlay_vec);
 746
 747   *endptr = endpos;
 748
 749   return intern_frame_face (f, &face);
 750 }
 751
 752 /* Return the face ID to use to display a special glyph which selects
 753    FACE_CODE as the face ID, assuming that ordinarily the face would
 754    be BASIC_FACE.  F is the frame.  */
 755 int
 756 compute_glyph_face (f, face_code)
 757      struct frame *f;
 758      int face_code;
 759 {
 760   struct face face;
 761
 762   bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (face));
 763   face.gc = 0;
 764
 765   if (face_code >= 0 && face_code < FRAME_N_FACES (f)
 766       && FRAME_FACES (f) [face_code] != 0)
 767     merge_faces (FRAME_FACES (f) [face_code], &face);
 768
 769   return intern_frame_face (f, &face);
 770 }
 771 \f
 772 /* Lisp interface. */
 773
 774 DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0,
 775        "")
 776      (frame)
 777      Lisp_Object frame;
 778 {
 779   CHECK_FRAME (frame, 0);
 780   return XFRAME (frame)->face_alist;
 781 }
 782
 783 DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist,
 784        2, 2, 0, "")
 785      (frame, value)
 786      Lisp_Object frame, value;
 787 {
 788   CHECK_FRAME (frame, 0);
 789   XFRAME (frame)->face_alist = value;
 790   return value;
 791 }
 792
 793
 794 DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0,
 795   "Create face number FACE-ID on all frames.")
 796   (face_id)
 797      Lisp_Object face_id;
 798 {
 799   Lisp_Object rest;
 800   int id = XINT (face_id);
 801
 802   CHECK_NUMBER (face_id, 0);
 803   if (id < 0 || id >= next_face_id)
 804     error ("Face id out of range");
 805
 806   for (rest = Vframe_list; !NILP (rest); rest = XCONS (rest)->cdr)
 807     {
 808       struct frame *f = XFRAME (XCONS (rest)->car);
 809       if (FRAME_X_P (f))
 810         ensure_face_ready (f, id);
 811     }
 812   return Qnil;
 813 }
 814
 815
 816 DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal,
 817        Sset_face_attribute_internal, 4, 4, 0, "")
 818      (face_id, attr_name, attr_value, frame)
 819      Lisp_Object face_id, attr_name, attr_value, frame;
 820 {
 821   struct face *face;
 822   struct frame *f;
 823   int magic_p;
 824   int id;
 825
 826   CHECK_FRAME (frame, 0);
 827   CHECK_NUMBER (face_id, 0);
 828   CHECK_SYMBOL (attr_name, 0);
 829
 830   f = XFRAME (frame);
 831   id = XINT (face_id);
 832   if (id < 0 || id >= next_face_id)
 833     error ("Face id out of range");
 834
 835   if (! FRAME_X_P (f))
 836     return;
 837
 838   ensure_face_ready (f, id);
 839   face = FRAME_FACES (f) [XFASTINT (face_id)];
 840
 841   if (EQ (attr_name, intern ("font")))
 842     {
 843       XFontStruct *font = load_font (f, attr_value);
 844       unload_font (f, face->font);
 845       face->font = font;
 846     }
 847   else if (EQ (attr_name, intern ("foreground")))
 848     {
 849       unsigned long new_color = load_color (f, attr_value);
 850       unload_color (f, face->foreground);
 851       face->foreground = new_color;
 852     }
 853   else if (EQ (attr_name, intern ("background")))
 854     {
 855       unsigned long new_color = load_color (f, attr_value);
 856       unload_color (f, face->background);
 857       face->background = new_color;
 858     }
 859 #if 0
 860   else if (EQ (attr_name, intern ("background-pixmap")))
 861     {
 862       unsigned int w, h, d;
 863       unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h, &d, 0);
 864       unload_pixmap (f, face->stipple);
 865       if (NILP (attr_value))
 866         new_pixmap = 0;
 867       face->stipple = new_pixmap;
 868       face->pixmap_w = w;
 869       face->pixmap_h = h;
 870 /*      face->pixmap_depth = d; */
 871     }
 872 #endif /* 0 */
 873   else if (EQ (attr_name, intern ("underline")))
 874     {
 875       int new = !NILP (attr_value);
 876       face->underline = new;
 877     }
 878   else
 879     error ("unknown face attribute");
 880
 881   if (id == 0)
 882     {
 883       BLOCK_INPUT;
 884       if (FRAME_DEFAULT_FACE (f)->gc != 0)
 885         XFreeGC (x_current_display, FRAME_DEFAULT_FACE (f)->gc);
 886       build_face (f, FRAME_DEFAULT_FACE (f));
 887       UNBLOCK_INPUT;
 888     }
 889
 890   if (id == 1)
 891     {
 892       BLOCK_INPUT;
 893       if (FRAME_MODE_LINE_FACE (f)->gc != 0)
 894         XFreeGC (x_current_display, FRAME_MODE_LINE_FACE (f)->gc);
 895       build_face (f, FRAME_MODE_LINE_FACE (f));
 896       UNBLOCK_INPUT;
 897     }
 898
 899   return Qnil;
 900 }
 901
 902 DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id,
 903   0, 0, 0, "")
 904   ()
 905 {
 906   return make_number (next_face_id++);
 907 }
 908
 909 /* Return the face id for name NAME on frame FRAME.
 910    (It should be the same for all frames,
 911    but it's as easy to use the "right" frame to look it up
 912    as to use any other one.)  */
 913
 914 static Lisp_Object
 915 face_name_id_number (frame, name)
 916      Lisp_Object frame, name;
 917 {
 918   Lisp_Object tem;
 919
 920   CHECK_FRAME (frame, 0);
 921   tem = Fcdr (Fassq (name, XFRAME (frame)->face_alist));
 922   if (NILP (tem))
 923     return 0;
 924   CHECK_VECTOR (tem, 0);
 925   tem = XVECTOR (tem)->contents[2];
 926   CHECK_NUMBER (tem, 0);
 927   return XINT (tem);
 928 }
 929 \f
 930 /* Emacs initialization.  */
 931
 932 void
 933 syms_of_xfaces ()
 934 {
 935   Qwindow = intern ("window");
 936   staticpro (&Qwindow);
 937   Qface = intern ("face");
 938   staticpro (&Qface);
 939   Qpriority = intern ("priority");
 940   staticpro (&Qpriority);
 941
 942   defsubr (&Sframe_face_alist);
 943   defsubr (&Sset_frame_face_alist);
 944   defsubr (&Smake_face_internal);
 945   defsubr (&Sset_face_attribute_internal);
 946   defsubr (&Sinternal_next_face_id);
 947 }
 948
 949 #endif /* HAVE_X_WINDOWS */
 950