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 #include "xterm.h"
  29 #include "buffer.h"
  30 #include "dispextern.h"
  31 #include "frame.h"
  32 #include "blockinput.h"
  33 /* #include "window.h" */
  34
  35 /* Display Context for the icons */
  36 #include <X11/Intrinsic.h>
  37 #include <X11/StringDefs.h>
  38 /* #include <X11/Xmu/Drawing.h> */  /* Appears not to be used */
  39 #include <X11/Xos.h>
  40
  41 /* We use face structures in two ways:
  42    At the frame level, each frame has a vector of faces (FRAME_FACES).
  43    Face number 0 is the default face (for normal text).
  44    Face number 1 is the mode line face.
  45    Higher face numbers have no built-in meaning.
  46    The faces in these vectors are called "frame faces".
  47
  48    Faces number 0 and 1 have graphics contexts.
  49    They can be used in the redisplay code directly.
  50    Higher numbered frame faces do not have graphics contexts.
  51
  52    There are also "cached faces".  They have graphics contexts.
  53    They are kept in a C vector called face_vector.
  54
  55    A "display face" is a face with a graphics context.
  56    It is either a frame face number 0 or 1,
  57    or a cached face.  */
  58
  59 /* A table of display faces.  */
  60 struct face **face_vector;
  61 /* The length in use of the table.  */
  62 int nfaces;
  63 /* The allocated length of the table.   */
  64 int nfaces_allocated;
  65
  66 /* The number of face-id's in use (same for all frames).  */
  67 int next_face_id;
  68
  69 #define FACE_DEFAULT (~0)
  70
  71 Lisp_Object Qface, Qwindow, Qpriority;
  72
  73 static struct face *allocate_face ();
  74 static void build_face ();
  75 static int sort_overlays ();
  76 static struct face *get_display_face ();
  77 static Lisp_Object face_name_id_number ();
  78 \f
  79 /* Make a new face that's a copy of an existing one.  */
  80
  81 static struct face *
  82 copy_face (face)
  83      struct face *face;
  84 {
  85   struct face *result = allocate_face ();
  86
  87   result->font = face->font;
  88   result->foreground = face->foreground;
  89   result->background = face->background;
  90   result->stipple = face->stipple;
  91   result->underline = face->underline;
  92
  93   return result;
  94 }
  95
  96 static int
  97 face_eql (face1, face2)
  98      struct face *face1, *face2;
  99 {
 100   return (face1->font == face2->font
 101           && face1->foreground == face2->foreground
 102           && face1->background == face2->background
 103           && face1->stipple == face2->stipple
 104           && face1->underline == face2->underline);
 105 }
 106
 107 /* Return the unique display face corresponding to the user-level face FACE.
 108
 109    If there isn't one, make one, and find a slot in the face_vector to
 110    put it in.  */
 111
 112 static struct face *
 113 get_cached_face (f, face)
 114      struct frame *f;
 115      struct face *face;
 116 {
 117   int i, empty = -1;
 118   struct face *result;
 119
 120   /* Look for an existing display face that does the job.
 121      Also find an empty slot if any.   */
 122   for (i = 0; i < nfaces; i++)
 123     {
 124       if (face_eql (face_vector[i], face))
 125         return face_vector[i];
 126       if (face_vector[i] == 0)
 127         empty = i;
 128     }
 129
 130   /* If no empty slots, make one.  */
 131   if (empty < 0 && nfaces == nfaces_allocated)
 132     {
 133       int newsize = nfaces + 20;
 134       face_vector
 135         = (struct face **) xrealloc (face_vector,
 136                                      newsize * sizeof (struct face *));
 137       nfaces_allocated = newsize;
 138     }
 139
 140   if (empty < 0)
 141     empty = nfaces++;
 142
 143   /* Put a new display face in the empty slot.  */
 144   result = copy_face (face);
 145   face_vector[empty] = result;
 146
 147   /* Make a graphics context for it.  */
 148   build_face (f, result);
 149
 150   return result;
 151 }
 152
 153 /* Clear out face_vector and start anew.
 154    This should be done from time to time just to avoid
 155    keeping too many graphics contexts in face_vector
 156    that are no longer needed.  */
 157
 158 void
 159 clear_face_vector ()
 160 {
 161   Lisp_Object rest;
 162   Display *dpy = x_current_display;
 163   int i;
 164
 165   BLOCK_INPUT;
 166   /* Free the display faces in the face_vector.  */
 167   for (i = 0; i < nfaces; i++)
 168     {
 169       struct face *face = face_vector[i];
 170       if (face->gc)
 171         XFreeGC (dpy, face->gc);
 172       xfree (face);
 173     }
 174   nfaces = 0;
 175
 176   UNBLOCK_INPUT;
 177 }
 178 \f
 179 /* Make a graphics context for face FACE, which is on frame F,
 180    if that can be done.  */
 181
 182 static void
 183 build_face (f, face)
 184      struct frame* f;
 185      struct face* face;
 186 {
 187   GC gc;
 188   XGCValues xgcv;
 189   unsigned long mask;
 190
 191   if (face->foreground != FACE_DEFAULT)
 192     xgcv.foreground = face->foreground;
 193   else
 194     xgcv. foreground = f->display.x->foreground_pixel;
 195   if (face->background != FACE_DEFAULT)
 196     xgcv.background = face->background;
 197   else
 198     xgcv. background = f->display.x->background_pixel;
 199   if (face->font && (int) face->font != FACE_DEFAULT)
 200     xgcv.font = face->font->fid;
 201   else
 202     xgcv.font = f->display.x->font->fid;
 203   xgcv.graphics_exposures = 0;
 204   mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
 205   gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
 206                   mask, &xgcv);
 207 #if 0
 208   if (face->stipple && face->stipple != FACE_DEFAULT)
 209     XSetStipple (x_current_display, gc, face->stipple);
 210 #endif
 211   face->gc = gc;
 212 }
 213 \f
 214 /* Modify face TO by copying from FROM all properties which have
 215    nondefault settings.  */
 216
 217 static void
 218 merge_faces (from, to)
 219      struct face *from, *to;
 220 {
 221   if (from->font != (XFontStruct *)FACE_DEFAULT)
 222     {
 223       to->font = from->font;
 224     }
 225   if (from->foreground != FACE_DEFAULT)
 226     to->foreground = from->foreground;
 227   if (from->background != FACE_DEFAULT)
 228     to->background = from->background;
 229   if (from->stipple != FACE_DEFAULT)
 230     to->stipple = from->stipple;
 231   if (from->underline)
 232     to->underline = from->underline;
 233 }
 234
 235 struct sortvec
 236 {
 237   Lisp_Object overlay;
 238   int beg, end;
 239   int priority;
 240 };
 241
 242 /* Return the display face associated with a buffer position POS.
 243    Store into *ENDPTR the position at which a different face is needed.
 244    This does not take account of glyphs that specify their own face codes.
 245    F is the frame in use for display, and W is the window.  */
 246
 247 struct face *
 248 compute_char_face (f, w, pos, endptr)
 249      struct frame *f;
 250      struct window *w;
 251      int pos;
 252      int *endptr;
 253 {
 254   struct face face;
 255   Lisp_Object prop, position, length;
 256   Lisp_Object overlay, start, end;
 257   int i, j, noverlays;
 258   int facecode;
 259   int endpos;
 260   Lisp_Object *overlay_vec;
 261   int len;
 262   struct sortvec *sortvec;
 263   Lisp_Object frame;
 264
 265   XSET (frame, Lisp_Frame, f);
 266
 267   XFASTINT (position) = pos;
 268   prop = Fget_text_property (position, Qface);
 269
 270   len = 10;
 271   overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
 272   noverlays = overlays_at (pos, &overlay_vec, &len, &endpos);
 273
 274   /* Optimize the default case.  */
 275   if (noverlays == 0 && NILP (prop))
 276     return FRAME_DEFAULT_FACE (f);
 277
 278   bcopy (FRAME_DEFAULT_FACE (f), &face, sizeof (struct face));
 279
 280   if (!NILP (prop))
 281     {
 282       facecode = face_name_id_number (frame, prop);
 283       if (facecode >= 0 && facecode < FRAME_N_FACES (f)
 284           && FRAME_FACES (f) [facecode] != 0)
 285         merge_faces (FRAME_FACES (f) [facecode], &face);
 286     }
 287
 288   /* Put the valid and relevant overlays into sortvec.  */
 289   sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
 290
 291   for (i = 0, j = 0; i < noverlays; i++)
 292     {
 293       overlay = overlay_vec[i];
 294
 295       if (OVERLAY_VALID (overlay)
 296           && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
 297           && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
 298         {
 299           Lisp_Object window;
 300           window = Foverlay_get (overlay, Qwindow);
 301
 302           /* Also ignore overlays limited to one window
 303              if it's not the window we are using.  */
 304           if (NILP (window) || XWINDOW (window) == w)
 305             {
 306               Lisp_Object tem;
 307
 308               /* This overlay is good and counts:
 309                  put it in sortvec.  */
 310               sortvec[j].overlay = overlay;
 311               sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
 312               sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
 313               tem = Foverlay_get (overlay, Qpriority);
 314               if (INTEGERP (tem))
 315                 sortvec[j].priority = XINT (tem);
 316               else
 317                 sortvec[j].priority = 0;
 318               j++;
 319             }
 320         }
 321     }
 322   noverlays = j;
 323
 324   /* Sort the overlays into the proper order: increasing priority.  */
 325
 326   qsort (sortvec, noverlays, sizeof (struct sortvec), sort_overlays);
 327
 328   /* Now merge the overlay data in that order.  */
 329
 330   for (i = 0; i < noverlays; i++)
 331     {
 332       prop = Foverlay_get (overlay_vec[i], Qface);
 333       if (!NILP (prop))
 334         {
 335           Lisp_Object oend;
 336           int oendpos;
 337
 338           facecode = face_name_id_number (frame, prop);
 339           if (facecode >= 0 && facecode < FRAME_N_FACES (f)
 340               && FRAME_FACES (f) [facecode] != 0)
 341             merge_faces (FRAME_FACES (f) [facecode], &face);
 342
 343           oend = OVERLAY_END (overlay_vec[i]);
 344           oendpos = OVERLAY_POSITION (oend);
 345           if (oendpos > endpos)
 346             endpos = oendpos;
 347         }
 348     }
 349
 350   xfree (overlay_vec);
 351
 352   *endptr = endpos;
 353
 354   return get_display_face (f, &face);
 355 }
 356
 357 static int
 358 sort_overlays (s1, s2)
 359      struct sortvec *s1, *s2;
 360 {
 361   if (s1->priority != s2->priority)
 362     return s1->priority - s2->priority;
 363   if (s1->beg != s2->beg)
 364     return s1->beg - s2->beg;
 365   if (s1->end != s2->end)
 366     return s2->end - s1->end;
 367   return 0;
 368 }
 369
 370 /* Return the display face to use to display a special glyph
 371    which selects FACE_CODE as the face ID,
 372    assuming that ordinarily the face would be BASIC_FACE.
 373    F is the frame.  */
 374
 375 struct face *
 376 compute_glyph_face (f, basic_face, face_code)
 377      struct frame *f;
 378      struct face *basic_face;
 379      int face_code;
 380 {
 381   struct face face;
 382
 383   bcopy (basic_face, &face, sizeof (struct face));
 384
 385   if (face_code >= 0 && face_code < FRAME_N_FACES (f)
 386       && FRAME_FACES (f) [face_code] != 0)
 387     merge_faces (FRAME_FACES (f) [face_code], &face);
 388
 389   return get_display_face (f, &face);
 390 }
 391 \f
 392 /* Given a frame face, return an equivalent display face
 393    (one which has a graphics context).  */
 394
 395 static struct face *
 396 get_display_face (f, face)
 397      struct frame *f;
 398      struct face *face;
 399 {
 400   struct face *result;
 401
 402   /* Does the face have a GC already?  */
 403   if (face->gc)
 404     return face;
 405
 406   /* If it's equivalent to the default face, use that.  */
 407   if (face->font == FRAME_DEFAULT_FACE (f)->font
 408       && face->foreground == FRAME_DEFAULT_FACE (f)->foreground
 409       && face->background == FRAME_DEFAULT_FACE (f)->background
 410       && face->stipple == FRAME_DEFAULT_FACE (f)->stipple
 411       && face->underline == FRAME_DEFAULT_FACE (f)->underline)
 412     {
 413       if (!FRAME_DEFAULT_FACE (f)->gc)
 414         build_face (f, FRAME_DEFAULT_FACE (f));
 415       return FRAME_DEFAULT_FACE (f);
 416     }
 417
 418   /* If it's equivalent to the mode line face, use that.  */
 419   if (face->font == FRAME_MODE_LINE_FACE (f)->font
 420       && face->foreground == FRAME_MODE_LINE_FACE (f)->foreground
 421       && face->background == FRAME_MODE_LINE_FACE (f)->background
 422       && face->stipple == FRAME_MODE_LINE_FACE (f)->stipple
 423       && face->underline == FRAME_MODE_LINE_FACE (f)->underline)
 424     {
 425       if (!FRAME_MODE_LINE_FACE (f)->gc)
 426         build_face (f, FRAME_MODE_LINE_FACE (f));
 427       return FRAME_MODE_LINE_FACE (f);
 428     }
 429
 430   /* Get a specialized display face.  */
 431   return get_cached_face (f, face);
 432 }
 433
 434 \f
 435 /* Allocate a new face */
 436 static struct face *
 437 allocate_face ()
 438 {
 439   struct face *result = (struct face *) xmalloc (sizeof (struct face));
 440   bzero (result, sizeof (struct face));
 441   result->font = (XFontStruct *) FACE_DEFAULT;
 442   result->foreground = FACE_DEFAULT;
 443   result->background = FACE_DEFAULT;
 444   result->stipple = FACE_DEFAULT;
 445   return result;
 446 }
 447
 448 /* Make face id ID valid on frame F.  */
 449
 450 void
 451 ensure_face_ready (f, id)
 452      struct frame *f;
 453      int id;
 454 {
 455   if (FRAME_N_FACES (f) <= id)
 456     {
 457       int n = id + 10;
 458       int i;
 459       if (!FRAME_N_FACES (f))
 460         FRAME_FACES (f)
 461           = (struct face **) xmalloc (sizeof (struct face *) * n);
 462       else
 463         FRAME_FACES (f)
 464           = (struct face **) xrealloc (FRAME_FACES (f),
 465                                        sizeof (struct face *) * n);
 466
 467       bzero (FRAME_FACES (f) + FRAME_N_FACES (f),
 468              (n - FRAME_N_FACES (f)) * sizeof (struct face *));
 469       FRAME_N_FACES (f) = n;
 470     }
 471
 472   if (FRAME_FACES (f) [id] == 0)
 473     FRAME_FACES (f) [id] = allocate_face ();
 474 }
 475 \f
 476 /* Allocating, freeing, and duplicating fonts, colors, and pixmaps.  */
 477
 478 #ifdef HAVE_X_WINDOWS
 479
 480 static XFontStruct *
 481 load_font (f, name)
 482      struct frame *f;
 483      Lisp_Object name;
 484 {
 485   XFontStruct *font;
 486
 487   if (NILP (name))
 488     return (XFontStruct *) FACE_DEFAULT;
 489
 490   CHECK_STRING (name, 0);
 491   BLOCK_INPUT;
 492   font = XLoadQueryFont (x_current_display, (char *) XSTRING (name)->data);
 493   UNBLOCK_INPUT;
 494
 495   if (! font)
 496     Fsignal (Qerror, Fcons (build_string ("undefined font"),
 497                             Fcons (name, Qnil)));
 498   return font;
 499 }
 500
 501 static void
 502 unload_font (f, font)
 503      struct frame *f;
 504      XFontStruct *font;
 505 {
 506   if (!font || font == ((XFontStruct *) FACE_DEFAULT))
 507     return;
 508   XFreeFont (x_current_display, font);
 509 }
 510
 511 static unsigned long
 512 load_color (f, name)
 513      struct frame *f;
 514      Lisp_Object name;
 515 {
 516   Display *dpy = x_current_display;
 517   Colormap cmap;
 518   XColor color;
 519   int result;
 520
 521   if (NILP (name))
 522     return FACE_DEFAULT;
 523
 524   cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
 525
 526   CHECK_STRING (name, 0);
 527   BLOCK_INPUT;
 528   result = XParseColor (dpy, cmap, (char *) XSTRING (name)->data, &color);
 529   UNBLOCK_INPUT;
 530   if (! result)
 531     Fsignal (Qerror, Fcons (build_string ("undefined color"),
 532                             Fcons (name, Qnil)));
 533   BLOCK_INPUT;
 534   result = XAllocColor (dpy, cmap, &color);
 535   UNBLOCK_INPUT;
 536   if (! result)
 537     Fsignal (Qerror, Fcons (build_string ("X server cannot allocate color"),
 538                             Fcons (name, Qnil)));
 539   return (unsigned long) color.pixel;
 540 }
 541
 542 static void
 543 unload_color (f, pixel)
 544      struct frame *f;
 545      Pixel pixel;
 546 {
 547   Colormap cmap;
 548   Display *dpy = x_current_display;
 549   if (pixel == FACE_DEFAULT)
 550     return;
 551   cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display));
 552   BLOCK_INPUT;
 553   XFreeColors (dpy, cmap, &pixel, 1, 0);
 554   UNBLOCK_INPUT;
 555 }
 556
 557 #endif /* HAVE_X_WINDOWS */
 558
 559 \f
 560 /* frames */
 561
 562 void
 563 init_frame_faces (f)
 564      struct frame *f;
 565 {
 566   struct frame *other_frame = 0;
 567   Lisp_Object rest;
 568
 569   for (rest = Vframe_list; !NILP (rest); rest = Fcdr (rest))
 570     {
 571       struct frame *f2 = XFRAME (Fcar (rest));
 572       if (f2 != f && FRAME_X_P (f2))
 573         {
 574           other_frame = f2;
 575           break;
 576         }
 577     }
 578
 579   if (other_frame)
 580     {
 581       /* Make sure this frame's face vector is as big as the others.  */
 582       FRAME_N_FACES (f) = FRAME_N_FACES (other_frame);
 583       FRAME_FACES (f)
 584         = (struct face **) xmalloc (FRAME_N_FACES (f) * sizeof (struct face *));
 585
 586       /* Make sure the frame has the two basic faces.  */
 587       FRAME_DEFAULT_FACE (f)
 588         = copy_face (FRAME_DEFAULT_FACE (other_frame));
 589       FRAME_MODE_LINE_FACE (f)
 590         = copy_face (FRAME_MODE_LINE_FACE (other_frame));
 591     }
 592 }
 593
 594
 595 /* Called from Fdelete_frame?  */
 596
 597 void
 598 free_screen_faces (f)
 599      struct frame *f;
 600 {
 601   Display *dpy = x_current_display;
 602   int i;
 603
 604   for (i = 0; i < FRAME_N_FACES (f); i++)
 605     {
 606       struct face *face = FRAME_FACES (f) [i];
 607       if (! face)
 608         continue;
 609       if (face->gc)
 610         XFreeGC (dpy, face->gc);
 611       unload_font (f, face->font);
 612       unload_color (f, face->foreground);
 613       unload_color (f, face->background);
 614 #if 0
 615       unload_pixmap (f, face->stipple);
 616 #endif
 617       xfree (face);
 618     }
 619   xfree (FRAME_FACES (f));
 620   FRAME_FACES (f) = 0;
 621   FRAME_N_FACES (f) = 0;
 622 }
 623
 624 \f
 625 /* Lisp interface */
 626
 627 DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0,
 628        "")
 629      (frame)
 630      Lisp_Object frame;
 631 {
 632   CHECK_FRAME (frame, 0);
 633   return XFRAME (frame)->face_alist;
 634 }
 635
 636 DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist,
 637        2, 2, 0, "")
 638      (frame, value)
 639      Lisp_Object frame, value;
 640 {
 641   CHECK_FRAME (frame, 0);
 642   XFRAME (frame)->face_alist = value;
 643   return value;
 644 }
 645
 646
 647 DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0,
 648   "Create face number FACE-ID on all frames.")
 649   (face_id)
 650      Lisp_Object face_id;
 651 {
 652   Lisp_Object rest;
 653   int id = XINT (face_id);
 654
 655   CHECK_NUMBER (face_id, 0);
 656   if (id < 0 || id >= next_face_id)
 657     error ("Face id out of range");
 658
 659   for (rest = Vframe_list; !NILP (rest); rest = XCONS (rest)->cdr)
 660     {
 661       struct frame *f = XFRAME (XCONS (rest)->car);
 662       ensure_face_ready (f, id);
 663     }
 664   return Qnil;
 665 }
 666
 667
 668 DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal,
 669        Sset_face_attribute_internal, 4, 4, 0, "")
 670      (face_id, attr_name, attr_value, frame)
 671      Lisp_Object face_id, attr_name, attr_value, frame;
 672 {
 673   struct face *face;
 674   struct frame *f;
 675   int magic_p;
 676   int id;
 677
 678   CHECK_FRAME (frame, 0);
 679   CHECK_NUMBER (face_id, 0);
 680   CHECK_SYMBOL (attr_name, 0);
 681
 682   f = XFRAME (frame);
 683   id = XINT (face_id);
 684   if (id < 0 || id >= next_face_id)
 685     error ("Face id out of range");
 686
 687   ensure_face_ready (f, id);
 688   face = FRAME_FACES (f) [XFASTINT (face_id)];
 689
 690   if (EQ (attr_name, intern ("font")))
 691     {
 692       XFontStruct *font = load_font (f, attr_value);
 693       unload_font (f, face->font);
 694       face->font = font;
 695     }
 696   else if (EQ (attr_name, intern ("foreground")))
 697     {
 698       unsigned long new_color = load_color (f, attr_value);
 699       unload_color (f, face->foreground);
 700       face->foreground = new_color;
 701     }
 702   else if (EQ (attr_name, intern ("background")))
 703     {
 704       unsigned long new_color = load_color (f, attr_value);
 705       unload_color (f, face->background);
 706       face->background = new_color;
 707     }
 708 #if 0
 709   else if (EQ (attr_name, intern ("background-pixmap")))
 710     {
 711       unsigned int w, h, d;
 712       unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h, &d, 0);
 713       unload_pixmap (f, face->stipple);
 714       if (NILP (attr_value))
 715         new_pixmap = 0;
 716       face->stipple = new_pixmap;
 717       face->pixmap_w = w;
 718       face->pixmap_h = h;
 719 /*      face->pixmap_depth = d; */
 720     }
 721 #endif /* 0 */
 722   else if (EQ (attr_name, intern ("underline")))
 723     {
 724       int new = !NILP (attr_value);
 725       face->underline = new;
 726     }
 727   else
 728     error ("unknown face attribute");
 729
 730   if (id == 0)
 731     {
 732       BLOCK_INPUT;
 733       if (FRAME_DEFAULT_FACE (f)->gc != 0)
 734         XFreeGC (x_current_display, FRAME_DEFAULT_FACE (f)->gc);
 735       build_face (f, FRAME_DEFAULT_FACE (f));
 736       UNBLOCK_INPUT;
 737     }
 738
 739   if (id == 1)
 740     {
 741       BLOCK_INPUT;
 742       if (FRAME_MODE_LINE_FACE (f)->gc != 0)
 743         XFreeGC (x_current_display, FRAME_MODE_LINE_FACE (f)->gc);
 744       build_face (f, FRAME_MODE_LINE_FACE (f));
 745       UNBLOCK_INPUT;
 746     }
 747
 748   return Qnil;
 749 }
 750
 751 DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id,
 752   0, 0, 0, "")
 753   ()
 754 {
 755   return make_number (next_face_id++);
 756 }
 757
 758 /* Return the face id for name NAME on frame FRAME.
 759    (It should be the same for all frames,
 760    but it's as easy to use the "right" frame to look it up
 761    as to use any other one.)  */
 762
 763 static Lisp_Object
 764 face_name_id_number (frame, name)
 765      Lisp_Object frame, name;
 766 {
 767   Lisp_Object tem;
 768
 769   CHECK_FRAME (frame, 0);
 770   tem = Fcdr (Fassq (name, XFRAME (frame)->face_alist));
 771   CHECK_VECTOR (tem, 0);
 772   tem = XVECTOR (tem)->contents[2];
 773   CHECK_NUMBER (tem, 0);
 774   return XINT (tem);
 775 }
 776 \f
 777 void
 778 syms_of_xfaces ()
 779 {
 780   Qwindow = intern ("window");
 781   staticpro (&Qwindow);
 782   Qface = intern ("face");
 783   staticpro (&Qface);
 784   Qpriority = intern ("priority");
 785   staticpro (&Qpriority);
 786
 787   defsubr (&Sframe_face_alist);
 788   defsubr (&Sset_frame_face_alist);
 789   defsubr (&Smake_face_internal);
 790   defsubr (&Sset_face_attribute_internal);
 791   defsubr (&Sinternal_next_face_id);
 792 }