src/w32faces.c

   1 /* "Face" primitives on the Microsoft W32 API.
   2    Copyright (C) 1993, 1994, 1995 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, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 /* Ported xfaces.c for w32 - Kevin Gallo */
  22
  23 #include <sys/types.h>
  24 #include <sys/stat.h>
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28
  29 #include "w32term.h"
  30 #include "buffer.h"
  31 #include "dispextern.h"
  32 #include "frame.h"
  33 #include "blockinput.h"
  34 #include "window.h"
  35 #include "intervals.h"
  36
  37 \f
  38 /* An explanation of the face data structures.  */
  39
  40 /* ========================= Face Data Structures =========================
  41
  42    Let FACE-NAME be a symbol naming a face.
  43
  44    Let FACE-VECTOR be (assq FACE-NAME (frame-face-alist FRAME))
  45    FACE-VECTOR is either nil, or a vector of the form
  46        [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE-P]
  47    where
  48        face is the symbol `face',
  49        NAME is the symbol with which this vector is associated (a backpointer),
  50        ID is the face ID, an integer used internally by the C code to identify
  51            the face,
  52        FONT, FOREGROUND, and BACKGROUND are strings naming the fonts and colors
  53            to use with the face,
  54        BACKGROUND-PIXMAP is the name of an x bitmap filename, which we don't
  55            use right now, and
  56        UNDERLINE-P is non-nil if the face should be underlined.
  57    If any of these elements are nil, that parameter is considered
  58    unspecified; parameters from faces specified by lower-priority
  59    overlays or text properties, or the parameters of the frame itself,
  60    can show through.  (lisp/faces.el maintains these lists.)
  61
  62    (assq FACE-NAME global-face-data) returns a vector describing the
  63    global parameters for that face.
  64
  65    Let PARAM-FACE be FRAME->display.x->param_faces[Faref (FACE-VECTOR, 2)].
  66    PARAM_FACE is a struct face whose members are the Xlib analogues of
  67    the parameters in FACE-VECTOR.  If an element of FACE-VECTOR is
  68    nil, then the corresponding member of PARAM_FACE is FACE_DEFAULT.
  69    These faces are called "parameter faces", because they're the ones
  70    lisp manipulates to control what gets displayed.  Elements 0 and 1
  71    of FRAME->display.x->param_faces are special - they describe the
  72    default and mode line faces.  None of the faces in param_faces have
  73    GC's.  (See src/dispextern.h for the definition of struct face.
  74    lisp/faces.el maintains the isomorphism between face_alist and
  75    param_faces.)
  76
  77    The functions compute_char_face and compute_glyph_face find and
  78    combine the parameter faces associated with overlays and text
  79    properties.  The resulting faces are called "computed faces"; none
  80    of their members are FACE_DEFAULT; they are completely specified.
  81    They then call intern_compute_face to search
  82    FRAME->display.x->computed_faces for a matching face, add one if
  83    none is found, and return the index into
  84    FRAME->display.x->computed_faces.  FRAME's glyph matrices use these
  85    indices to record the faces of the matrix characters, and the X
  86    display hooks consult compute_faces to decide how to display these
  87    characters.  Elements 0 and 1 of computed_faces always describe the
  88    default and mode-line faces.
  89
  90    Each computed face belongs to a particular frame.
  91
  92    Computed faces have graphics contexts some of the time.
  93    intern_face builds a GC for a specified computed face
  94    if it doesn't have one already.
  95    clear_face_cache clears out the GCs of all computed faces.
  96    This is done from time to time so that we don't hold on to
  97    lots of GCs that are no longer needed.
  98
  99    Constraints:
 100
 101    Symbols naming faces must have associations on all frames; for any
 102    FRAME, for all FACE-NAME, if (assq FACE-NAME (frame-face-alist
 103    FRAME)) is non-nil, it must be non-nil for all frames.
 104
 105    Analogously, indices into param_faces must be valid on all frames;
 106    if param_faces[i] is a non-zero face pointer on one frame, then it
 107    must be filled in on all frames.  Code assumes that face ID's can
 108    be used on any frame.
 109
 110    Some subtleties:
 111
 112    Why do we keep param_faces and computed_faces separate?
 113    computed_faces contains an element for every combination of facial
 114    parameters we have ever displayed.  indices into param_faces have
 115    to be valid on all frames.  If they were the same array, then that
 116    array would grow very large on all frames, because any facial
 117    combination displayed on any frame would need to be a valid entry
 118    on all frames.  */
 119 \f
 120 /* Definitions and declarations.  */
 121
 122 /* The number of face-id's in use (same for all frames).  */
 123 static int next_face_id;
 124
 125 /* The number of the face to use to indicate the region.  */
 126 static int region_face;
 127
 128 /* This is what appears in a slot in a face to signify that the face
 129    does not specify that display aspect.  */
 130 #define FACE_DEFAULT (~0)
 131
 132 Lisp_Object Qface, Qmouse_face;
 133 Lisp_Object Qpixmap_spec_p;
 134
 135 int face_name_id_number ( /* FRAME_PTR, Lisp_Object name */ );
 136
 137 struct face *intern_face ( /* FRAME_PTR, struct face * */ );
 138 static int new_computed_face ( /* FRAME_PTR, struct face * */ );
 139 static int intern_computed_face ( /* FRAME_PTR, struct face * */ );
 140 static void ensure_face_ready ( /* FRAME_PTR, int id */ );
 141 void recompute_basic_faces ( /* FRAME_PTR f */ );
 142 static void merge_face_list ( /* FRAME_PTR, struct face *, Lisp_Object */ );
 143
 144 extern Lisp_Object Qforeground_color, Qbackground_color;
 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   result->pixmap_h = face->pixmap_h;
 174   result->pixmap_w = face->pixmap_w;
 175
 176   return result;
 177 }
 178
 179 static int
 180 face_eql (face1, face2)
 181      struct face *face1, *face2;
 182 {
 183   return (   face1->font       == face2->font
 184           && face1->foreground == face2->foreground
 185           && face1->background == face2->background
 186           && face1->stipple    == face2->stipple
 187           && face1->underline  == face2->underline);
 188 }
 189 \f
 190 /* Managing graphics contexts of faces.  */
 191
 192 /* Given a computed face, construct its graphics context if necessary.  */
 193
 194 struct face *
 195 intern_face (f, face)
 196      struct frame *f;
 197      struct face *face;
 198 {
 199   face->gc = NULL;
 200
 201   return face;
 202 }
 203
 204 /* Clear out all graphics contexts for all computed faces
 205    except for the default and mode line faces.
 206    This should be done from time to time just to avoid
 207    keeping too many graphics contexts that are no longer needed.  */
 208
 209 void
 210 clear_face_cache ()
 211 {
 212 /* Nothing extra */
 213 }
 214 \f
 215 /* Allocating, freeing, and duplicating fonts, colors, and pixmaps.
 216
 217    These functions operate on param faces only.
 218    Computed faces get their fonts, colors and pixmaps
 219    by merging param faces.  */
 220
 221 static XFontStruct *
 222 load_font (f, name)
 223      struct frame *f;
 224      Lisp_Object name;
 225 {
 226   XFontStruct *font;
 227
 228   if (NILP (name))
 229     return (XFontStruct *) FACE_DEFAULT;
 230
 231   CHECK_STRING (name, 0);
 232   BLOCK_INPUT;
 233   font = w32_load_font (FRAME_W32_DISPLAY_INFO (f), (char *) XSTRING (name)->data);
 234   UNBLOCK_INPUT;
 235
 236   if (! font)
 237     Fsignal (Qerror, Fcons (build_string ("undefined font"),
 238                             Fcons (name, Qnil)));
 239   return font;
 240 }
 241
 242 static void
 243 unload_font (f, font)
 244      struct frame *f;
 245      XFontStruct *font;
 246 {
 247   if (!font || font == ((XFontStruct *) FACE_DEFAULT))
 248     return;
 249
 250   BLOCK_INPUT;
 251   w32_unload_font (FRAME_W32_DISPLAY_INFO (f), font);
 252   UNBLOCK_INPUT;
 253 }
 254
 255 static unsigned long
 256 load_color (f, name)
 257      struct frame *f;
 258      Lisp_Object name;
 259 {
 260   COLORREF color;
 261   int result;
 262
 263   if (NILP (name))
 264     return FACE_DEFAULT;
 265
 266   CHECK_STRING (name, 0);
 267   /* if the colormap is full, defined_color will return a best match
 268      to the values in an an existing cell. */
 269   result = defined_color(f, (char *) XSTRING (name)->data, &color, 1);
 270   if (! result)
 271     Fsignal (Qerror, Fcons (build_string ("undefined color"),
 272                             Fcons (name, Qnil)));
 273   return (unsigned long) color;
 274 }
 275
 276 static void
 277 unload_color (f, pixel)
 278      struct frame *f;
 279      unsigned long pixel;
 280 {
 281 }
 282
 283 DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0,
 284   "Return t if ARG is a valid pixmap specification.")
 285   (arg)
 286      Lisp_Object arg;
 287 {
 288   Lisp_Object height, width;
 289
 290   return ((STRINGP (arg)
 291            || (CONSP (arg)
 292                && CONSP (XCONS (arg)->cdr)
 293                && CONSP (XCONS (XCONS (arg)->cdr)->cdr)
 294                && NILP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->cdr)
 295                && (width = XCONS (arg)->car, INTEGERP (width))
 296                && (height = XCONS (XCONS (arg)->cdr)->car, INTEGERP (height))
 297                && STRINGP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car)
 298                && XINT (width) > 0
 299                && XINT (height) > 0
 300                /* The string must have enough bits for width * height.  */
 301                && ((XSTRING (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car)->size
 302                     * (BITS_PER_INT / sizeof (int)))
 303                    >= XFASTINT (width) * XFASTINT (height))))
 304           ? Qt : Qnil);
 305 }
 306
 307 /* Load a bitmap according to NAME (which is either a file name
 308    or a pixmap spec).  Return the bitmap_id (see xfns.c)
 309    or get an error if NAME is invalid.
 310
 311    Store the bitmap width in *W_PTR and height in *H_PTR.  */
 312
 313 static long
 314 load_pixmap (f, name, w_ptr, h_ptr)
 315      FRAME_PTR f;
 316      Lisp_Object name;
 317      unsigned int *w_ptr, *h_ptr;
 318 {
 319   int bitmap_id;
 320   Lisp_Object tem;
 321
 322   if (NILP (name))
 323     return FACE_DEFAULT;
 324
 325   tem = Fpixmap_spec_p (name);
 326   if (NILP (tem))
 327     wrong_type_argument (Qpixmap_spec_p, name);
 328
 329   BLOCK_INPUT;
 330
 331   if (CONSP (name))
 332     {
 333       /* Decode a bitmap spec into a bitmap.  */
 334
 335       int h, w;
 336       Lisp_Object bits;
 337
 338       w = XINT (Fcar (name));
 339       h = XINT (Fcar (Fcdr (name)));
 340       bits = Fcar (Fcdr (Fcdr (name)));
 341
 342       bitmap_id = x_create_bitmap_from_data (f, XSTRING (bits)->data,
 343                                              w, h);
 344     }
 345   else
 346     {
 347       /* It must be a string -- a file name.  */
 348       bitmap_id = x_create_bitmap_from_file (f, name);
 349     }
 350   UNBLOCK_INPUT;
 351
 352   if (bitmap_id < 0)
 353     Fsignal (Qerror, Fcons (build_string ("invalid or undefined bitmap"),
 354                             Fcons (name, Qnil)));
 355
 356   *w_ptr = x_bitmap_width (f, bitmap_id);
 357   *h_ptr = x_bitmap_height (f, bitmap_id);
 358
 359   return bitmap_id;
 360 }
 361
 362 \f
 363 /* Managing parameter face arrays for frames. */
 364
 365 void
 366 init_frame_faces (f)
 367      FRAME_PTR f;
 368 {
 369   ensure_face_ready (f, 0);
 370   ensure_face_ready (f, 1);
 371
 372   FRAME_N_COMPUTED_FACES (f) = 0;
 373   FRAME_SIZE_COMPUTED_FACES (f) = 0;
 374
 375   new_computed_face (f, FRAME_PARAM_FACES (f)[0]);
 376   new_computed_face (f, FRAME_PARAM_FACES (f)[1]);
 377   recompute_basic_faces (f);
 378
 379   /* Find another frame.  */
 380   {
 381     Lisp_Object tail, frame, result;
 382
 383     result = Qnil;
 384     FOR_EACH_FRAME (tail, frame)
 385       if (FRAME_W32_P (XFRAME (frame))
 386           && XFRAME (frame) != f)
 387         {
 388           result = frame;
 389           break;
 390         }
 391
 392     /* If we didn't find any X frames other than f, then we don't need
 393        any faces other than 0 and 1, so we're okay.  Otherwise, make
 394        sure that all faces valid on the selected frame are also valid
 395        on this new frame.  */
 396     if (FRAMEP (result))
 397       {
 398         int i;
 399         int n_faces = FRAME_N_PARAM_FACES (XFRAME (result));
 400         struct face **faces = FRAME_PARAM_FACES (XFRAME (result));
 401
 402         for (i = 2; i < n_faces; i++)
 403           if (faces[i])
 404             ensure_face_ready (f, i);
 405       }
 406   }
 407 }
 408
 409
 410 /* Called from Fdelete_frame.  */
 411
 412 void
 413 free_frame_faces (f)
 414      struct frame *f;
 415 {
 416   int i;
 417
 418   BLOCK_INPUT;
 419
 420   for (i = 0; i < FRAME_N_PARAM_FACES (f); i++)
 421     {
 422       struct face *face = FRAME_PARAM_FACES (f) [i];
 423       if (face)
 424         {
 425           unload_font (f, face->font);
 426           unload_color (f, face->foreground);
 427           unload_color (f, face->background);
 428           x_destroy_bitmap (f, face->stipple);
 429           xfree (face);
 430         }
 431     }
 432   xfree (FRAME_PARAM_FACES (f));
 433   FRAME_PARAM_FACES (f) = 0;
 434   FRAME_N_PARAM_FACES (f) = 0;
 435
 436   /* All faces in FRAME_COMPUTED_FACES use resources copied from
 437      FRAME_PARAM_FACES; we can free them without fuss.
 438      But we do free the GCs and the face objects themselves.  */
 439   for (i = 0; i < FRAME_N_COMPUTED_FACES (f); i++)
 440     {
 441       struct face *face = FRAME_COMPUTED_FACES (f) [i];
 442       if (face)
 443         {
 444           xfree (face);
 445         }
 446     }
 447   xfree (FRAME_COMPUTED_FACES (f));
 448   FRAME_COMPUTED_FACES (f) = 0;
 449   FRAME_N_COMPUTED_FACES (f) = 0;
 450
 451   UNBLOCK_INPUT;
 452 }
 453 \f
 454 /* Interning faces in a frame's face array.  */
 455
 456 static int
 457 new_computed_face (f, new_face)
 458      struct frame *f;
 459      struct face *new_face;
 460 {
 461   int i = FRAME_N_COMPUTED_FACES (f);
 462
 463   if (i >= FRAME_SIZE_COMPUTED_FACES (f))
 464     {
 465       int new_size = i + 32;
 466
 467       FRAME_COMPUTED_FACES (f)
 468         = (struct face **) (FRAME_SIZE_COMPUTED_FACES (f) == 0
 469                             ? xmalloc (new_size * sizeof (struct face *))
 470                             : xrealloc (FRAME_COMPUTED_FACES (f),
 471                                         new_size * sizeof (struct face *)));
 472       FRAME_SIZE_COMPUTED_FACES (f) = new_size;
 473     }
 474
 475   i = FRAME_N_COMPUTED_FACES (f)++;
 476   FRAME_COMPUTED_FACES (f)[i] = copy_face (new_face);
 477   return i;
 478 }
 479
 480
 481 /* Find a match for NEW_FACE in a FRAME's computed face array, and add
 482    it if we don't find one.  */
 483 static int
 484 intern_computed_face (f, new_face)
 485      struct frame *f;
 486      struct face *new_face;
 487 {
 488   int len = FRAME_N_COMPUTED_FACES (f);
 489   int i;
 490
 491   /* Search for a computed face already on F equivalent to FACE.  */
 492   for (i = 0; i < len; i++)
 493     {
 494       if (! FRAME_COMPUTED_FACES (f)[i])
 495         abort ();
 496       if (face_eql (new_face, FRAME_COMPUTED_FACES (f)[i]))
 497         return i;
 498     }
 499
 500   /* We didn't find one; add a new one.  */
 501   return new_computed_face (f, new_face);
 502 }
 503
 504 /* Make parameter face id ID valid on frame F.  */
 505
 506 static void
 507 ensure_face_ready (f, id)
 508      struct frame *f;
 509      int id;
 510 {
 511   if (FRAME_N_PARAM_FACES (f) <= id)
 512     {
 513       int n = id + 10;
 514       int i;
 515       if (!FRAME_N_PARAM_FACES (f))
 516         FRAME_PARAM_FACES (f)
 517           = (struct face **) xmalloc (sizeof (struct face *) * n);
 518       else
 519         FRAME_PARAM_FACES (f)
 520           = (struct face **) xrealloc (FRAME_PARAM_FACES (f),
 521                                        sizeof (struct face *) * n);
 522
 523       bzero (FRAME_PARAM_FACES (f) + FRAME_N_PARAM_FACES (f),
 524              (n - FRAME_N_PARAM_FACES (f)) * sizeof (struct face *));
 525       FRAME_N_PARAM_FACES (f) = n;
 526     }
 527
 528   if (FRAME_PARAM_FACES (f) [id] == 0)
 529     FRAME_PARAM_FACES (f) [id] = allocate_face ();
 530 }
 531 \f
 532 /* Return non-zero if FONT1 and FONT2 have the same width.
 533    We do not check the height, because we can now deal with
 534    different heights.
 535    We assume that they're both character-cell fonts.  */
 536
 537 int
 538 same_size_fonts (font1, font2)
 539      XFontStruct *font1, *font2;
 540 {
 541   return (FONT_WIDTH(font1) == FONT_WIDTH(font2));
 542 }
 543
 544 /* Update the line_height of frame F according to the biggest font in
 545    any face.  Return nonzero if if line_height changes.  */
 546
 547 int
 548 frame_update_line_height (f)
 549      FRAME_PTR f;
 550 {
 551   int i;
 552   int biggest = FONT_HEIGHT (f->output_data.w32->font);
 553
 554   for (i = 0; i < f->output_data.w32->n_param_faces; i++)
 555     if (f->output_data.w32->param_faces[i] != 0
 556         && f->output_data.w32->param_faces[i]->font != (XFontStruct *) FACE_DEFAULT)
 557       {
 558         int height = FONT_HEIGHT (f->output_data.w32->param_faces[i]->font);
 559         if (height > biggest)
 560           biggest = height;
 561       }
 562
 563   if (biggest == f->output_data.w32->line_height)
 564     return 0;
 565
 566   f->output_data.w32->line_height = biggest;
 567   return 1;
 568 }
 569 \f
 570 /* Modify face TO by copying from FROM all properties which have
 571    nondefault settings.  */
 572
 573 static void
 574 merge_faces (from, to)
 575      struct face *from, *to;
 576 {
 577   /* Only merge the font if it's the same width as the base font.
 578      Otherwise ignore it, since we can't handle it properly.  */
 579   if (from->font != (XFontStruct *) FACE_DEFAULT
 580       && same_size_fonts (from->font, to->font))
 581     to->font = from->font;
 582   if (from->foreground != FACE_DEFAULT)
 583     to->foreground = from->foreground;
 584   if (from->background != FACE_DEFAULT)
 585     to->background = from->background;
 586   if (from->stipple != FACE_DEFAULT)
 587     {
 588       to->stipple = from->stipple;
 589       to->pixmap_h = from->pixmap_h;
 590       to->pixmap_w = from->pixmap_w;
 591     }
 592   if (from->underline)
 593     to->underline = from->underline;
 594 }
 595
 596 /* Set up the basic set of facial parameters, based on the frame's
 597    data; all faces are deltas applied to this.  */
 598
 599 static void
 600 compute_base_face (f, face)
 601      FRAME_PTR f;
 602      struct face *face;
 603 {
 604   face->gc = 0;
 605   face->foreground = FRAME_FOREGROUND_PIXEL (f);
 606   face->background = FRAME_BACKGROUND_PIXEL (f);
 607   face->font = FRAME_FONT (f);
 608   face->stipple = 0;
 609   face->underline = 0;
 610 }
 611
 612 /* Return the face ID to use to display a special glyph which selects
 613    FACE_CODE as the face ID, assuming that ordinarily the face would
 614    be CURRENT_FACE.  F is the frame.  */
 615
 616 int
 617 compute_glyph_face (f, face_code, current_face)
 618      struct frame *f;
 619      int face_code, current_face;
 620 {
 621   struct face face;
 622
 623   face = *FRAME_COMPUTED_FACES (f)[current_face];
 624
 625   if (face_code >= 0 && face_code < FRAME_N_PARAM_FACES (f)
 626       && FRAME_PARAM_FACES (f) [face_code] != 0)
 627     merge_faces (FRAME_PARAM_FACES (f) [face_code], &face);
 628
 629   return intern_computed_face (f, &face);
 630 }
 631
 632 /* Return the face ID to use to display a special glyph which selects
 633    FACE_CODE as the face ID, assuming that ordinarily the face would
 634    be CURRENT_FACE.  F is the frame.  */
 635
 636 int
 637 compute_glyph_face_1 (f, face_name, current_face)
 638      struct frame *f;
 639      Lisp_Object face_name;
 640      int current_face;
 641 {
 642   struct face face;
 643
 644   face = *FRAME_COMPUTED_FACES (f)[current_face];
 645
 646   if (!NILP (face_name))
 647     {
 648       int facecode = face_name_id_number (f, face_name);
 649       if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f)
 650           && FRAME_PARAM_FACES (f) [facecode] != 0)
 651         merge_faces (FRAME_PARAM_FACES (f) [facecode], &face);
 652     }
 653
 654   return intern_computed_face (f, &face);
 655 }
 656 \f
 657 /* Return the face ID associated with a buffer position POS.
 658    Store into *ENDPTR the position at which a different face is needed.
 659    This does not take account of glyphs that specify their own face codes.
 660    F is the frame in use for display, and W is a window displaying
 661    the current buffer.
 662
 663    REGION_BEG, REGION_END delimit the region, so it can be highlighted.
 664
 665    LIMIT is a position not to scan beyond.  That is to limit
 666    the time this function can take.
 667
 668    If MOUSE is nonzero, use the character's mouse-face, not its face.  */
 669 int
 670 compute_char_face (f, w, pos, region_beg, region_end, endptr, limit, mouse)
 671      struct frame *f;
 672      struct window *w;
 673      int pos;
 674      int region_beg, region_end;
 675      int *endptr;
 676      int limit;
 677      int mouse;
 678 {
 679   struct face face;
 680   Lisp_Object prop, position;
 681   int i, j, noverlays;
 682   int facecode;
 683   Lisp_Object *overlay_vec;
 684   Lisp_Object frame;
 685   int endpos;
 686   Lisp_Object propname;
 687
 688   /* W must display the current buffer.  We could write this function
 689      to use the frame and buffer of W, but right now it doesn't.  */
 690   if (XBUFFER (w->buffer) != current_buffer)
 691     abort ();
 692
 693   XSETFRAME (frame, f);
 694
 695   endpos = ZV;
 696   if (pos < region_beg && region_beg < endpos)
 697     endpos = region_beg;
 698
 699   XSETFASTINT (position, pos);
 700
 701   if (mouse)
 702     propname = Qmouse_face;
 703   else
 704     propname = Qface;
 705
 706   prop = Fget_text_property (position, propname, w->buffer);
 707
 708   {
 709     Lisp_Object limit1, end;
 710
 711     XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
 712     end = Fnext_single_property_change (position, propname, w->buffer, limit1);
 713     if (INTEGERP (end))
 714       endpos = XINT (end);
 715   }
 716
 717   {
 718     int next_overlay;
 719     int len;
 720
 721     /* First try with room for 40 overlays.  */
 722     len = 40;
 723     overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
 724
 725     noverlays = overlays_at (pos, 0, &overlay_vec, &len,
 726                              &next_overlay, (int *) 0);
 727
 728     /* If there are more than 40,
 729        make enough space for all, and try again.  */
 730     if (noverlays > len)
 731       {
 732         len = noverlays;
 733         overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
 734         noverlays = overlays_at (pos, 0, &overlay_vec, &len,
 735                                  &next_overlay, (int *) 0);
 736       }
 737
 738     if (next_overlay < endpos)
 739       endpos = next_overlay;
 740   }
 741
 742   *endptr = endpos;
 743
 744   /* Optimize the default case.  */
 745   if (noverlays == 0 && NILP (prop)
 746       && !(pos >= region_beg && pos < region_end))
 747     return 0;
 748
 749   compute_base_face (f, &face);
 750
 751   merge_face_list (f, &face, prop);
 752
 753   noverlays = sort_overlays (overlay_vec, noverlays, w);
 754
 755   /* Now merge the overlay data in that order.  */
 756   for (i = 0; i < noverlays; i++)
 757     {
 758       Lisp_Object oend;
 759       int oendpos;
 760
 761       prop = Foverlay_get (overlay_vec[i], propname);
 762       merge_face_list (f, &face, prop);
 763
 764       oend = OVERLAY_END (overlay_vec[i]);
 765       oendpos = OVERLAY_POSITION (oend);
 766       if (oendpos < endpos)
 767         endpos = oendpos;
 768     }
 769
 770   if (pos >= region_beg && pos < region_end)
 771     {
 772       if (region_end < endpos)
 773         endpos = region_end;
 774       if (region_face >= 0 && region_face < next_face_id)
 775         merge_faces (FRAME_PARAM_FACES (f)[region_face], &face);
 776     }
 777
 778   *endptr = endpos;
 779
 780   return intern_computed_face (f, &face);
 781 }
 782
 783 static void
 784 merge_face_list (f, face, prop)
 785      FRAME_PTR f;
 786      struct face *face;
 787      Lisp_Object prop;
 788 {
 789   Lisp_Object length;
 790   int len;
 791   Lisp_Object *faces;
 792   int j;
 793
 794   if (CONSP (prop)
 795       && ! STRINGP (XCONS (prop)->cdr))
 796     {
 797       /* We have a list of faces, merge them in reverse order.  */
 798
 799       length = Fsafe_length (prop);
 800       len = XFASTINT (length);
 801
 802       /* Put them into an array.  */
 803       faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
 804       for (j = 0; j < len; j++)
 805         {
 806           faces[j] = Fcar (prop);
 807           prop = Fcdr (prop);
 808         }
 809       /* So that we can merge them in the reverse order.  */
 810     }
 811   else
 812     {
 813       faces = (Lisp_Object *) alloca (sizeof (Lisp_Object));
 814       faces[0] = prop;
 815       len = 1;
 816     }
 817
 818   for (j = len - 1; j >= 0; j--)
 819     {
 820       if (CONSP (faces[j]))
 821         {
 822           if (EQ (XCONS (faces[j])->car, Qbackground_color))
 823             face->background = load_color (f, XCONS (faces[j])->cdr);
 824           if (EQ (XCONS (faces[j])->car, Qforeground_color))
 825             face->foreground = load_color (f, XCONS (faces[j])->cdr);
 826         }
 827       else
 828         {
 829           int facecode = face_name_id_number (f, faces[j]);
 830           if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f)
 831               && FRAME_PARAM_FACES (f) [facecode] != 0)
 832             merge_faces (FRAME_PARAM_FACES (f) [facecode], face);
 833         }
 834     }
 835 }
 836
 837 \f
 838 /* Recompute the GC's for the default and modeline faces.
 839    We call this after changing frame parameters on which those GC's
 840    depend.  */
 841
 842 void
 843 recompute_basic_faces (f)
 844      FRAME_PTR f;
 845 {
 846   /* If the frame's faces haven't been initialized yet, don't worry about
 847      this stuff.  */
 848   if (FRAME_N_PARAM_FACES (f) < 2)
 849     return;
 850
 851   BLOCK_INPUT;
 852
 853   compute_base_face (f, FRAME_DEFAULT_FACE (f));
 854   compute_base_face (f, FRAME_MODE_LINE_FACE (f));
 855
 856   merge_faces (FRAME_DEFAULT_PARAM_FACE (f), FRAME_DEFAULT_FACE (f));
 857   merge_faces (FRAME_MODE_LINE_PARAM_FACE (f), FRAME_MODE_LINE_FACE (f));
 858
 859   intern_face (f, FRAME_DEFAULT_FACE (f));
 860   intern_face (f, FRAME_MODE_LINE_FACE (f));
 861
 862   UNBLOCK_INPUT;
 863 }
 864
 865
 866 \f
 867 /* Lisp interface. */
 868
 869 DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0,
 870        "")
 871      (frame)
 872      Lisp_Object frame;
 873 {
 874   CHECK_FRAME (frame, 0);
 875   return XFRAME (frame)->face_alist;
 876 }
 877
 878 DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist,
 879        2, 2, 0, "")
 880      (frame, value)
 881      Lisp_Object frame, value;
 882 {
 883   CHECK_FRAME (frame, 0);
 884   XFRAME (frame)->face_alist = value;
 885   return value;
 886 }
 887
 888
 889 DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0,
 890   "Create face number FACE-ID on all frames.")
 891   (face_id)
 892      Lisp_Object face_id;
 893 {
 894   Lisp_Object rest, frame;
 895   int id = XINT (face_id);
 896
 897   CHECK_NUMBER (face_id, 0);
 898   if (id < 0 || id >= next_face_id)
 899     error ("Face id out of range");
 900
 901   FOR_EACH_FRAME (rest, frame)
 902     {
 903       if (FRAME_W32_P (XFRAME (frame)))
 904         ensure_face_ready (XFRAME (frame), id);
 905     }
 906   return Qnil;
 907 }
 908
 909
 910 DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal,
 911        Sset_face_attribute_internal, 4, 4, 0, "")
 912      (face_id, attr_name, attr_value, frame)
 913      Lisp_Object face_id, attr_name, attr_value, frame;
 914 {
 915   struct face *face;
 916   struct frame *f;
 917   int magic_p;
 918   int id;
 919   int garbaged = 0;
 920
 921   CHECK_FRAME (frame, 0);
 922   CHECK_NUMBER (face_id, 0);
 923   CHECK_SYMBOL (attr_name, 0);
 924
 925   f = XFRAME (frame);
 926   id = XINT (face_id);
 927   if (id < 0 || id >= next_face_id)
 928     error ("Face id out of range");
 929
 930   if (! FRAME_W32_P (f))
 931     return Qnil;
 932
 933   ensure_face_ready (f, id);
 934   face = FRAME_PARAM_FACES (f) [XFASTINT (face_id)];
 935
 936   if (EQ (attr_name, intern ("font")))
 937     {
 938       XFontStruct *font = load_font (f, attr_value);
 939       if (face->font != f->output_data.w32->font)
 940         unload_font (f, face->font);
 941       face->font = font;
 942       if (frame_update_line_height (f))
 943         x_set_window_size (f, 0, f->width, f->height);
 944       /* Must clear cache, since it might contain the font
 945          we just got rid of.  */
 946       garbaged = 1;
 947     }
 948   else if (EQ (attr_name, intern ("foreground")))
 949     {
 950       unsigned long new_color = load_color (f, attr_value);
 951       unload_color (f, face->foreground);
 952       face->foreground = new_color;
 953       garbaged = 1;
 954     }
 955   else if (EQ (attr_name, intern ("background")))
 956     {
 957       unsigned long new_color = load_color (f, attr_value);
 958       unload_color (f, face->background);
 959       face->background = new_color;
 960       garbaged = 1;
 961     }
 962   else if (EQ (attr_name, intern ("background-pixmap")))
 963     {
 964       unsigned int w, h;
 965       unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h);
 966       x_destroy_bitmap (f, face->stipple);
 967       face->stipple = (Pixmap) new_pixmap;
 968       face->pixmap_w = w;
 969       face->pixmap_h = h;
 970       garbaged = 1;
 971     }
 972   else if (EQ (attr_name, intern ("underline")))
 973     {
 974       int new = !NILP (attr_value);
 975       face->underline = new;
 976     }
 977   else
 978     error ("unknown face attribute");
 979
 980   if (id == 0 || id == 1)
 981     recompute_basic_faces (f);
 982
 983   /* We must redraw the frame whenever any face font or color changes,
 984      because it's possible that a merged (display) face
 985      contains the font or color we just replaced.
 986      And we must inhibit any Expose events until the redraw is done,
 987      since they would try to use the invalid display faces.  */
 988   if (garbaged)
 989     SET_FRAME_GARBAGED (f);
 990
 991   return Qnil;
 992 }
 993
 994 DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id,
 995   0, 0, 0, "")
 996   ()
 997 {
 998   return make_number (next_face_id++);
 999 }
1000
1001 /* Return the face id for name NAME on frame FRAME.
1002    (It should be the same for all frames,
1003    but it's as easy to use the "right" frame to look it up
1004    as to use any other one.)  */
1005
1006 int
1007 face_name_id_number (f, name)
1008      FRAME_PTR f;
1009      Lisp_Object name;
1010 {
1011   Lisp_Object tem;
1012
1013   tem = Fcdr (assq_no_quit (name, f->face_alist));
1014   if (NILP (tem))
1015     return 0;
1016   CHECK_VECTOR (tem, 0);
1017   tem = XVECTOR (tem)->contents[2];
1018   CHECK_NUMBER (tem, 0);
1019   return XINT (tem);
1020 }
1021 \f
1022 /* Emacs initialization.  */
1023
1024 void
1025 syms_of_w32faces ()
1026 {
1027   Qface = intern ("face");
1028   staticpro (&Qface);
1029   Qmouse_face = intern ("mouse-face");
1030   staticpro (&Qmouse_face);
1031   Qpixmap_spec_p = intern ("pixmap-spec-p");
1032   staticpro (&Qpixmap_spec_p);
1033
1034   DEFVAR_INT ("region-face", &region_face,
1035     "Face number to use to highlight the region\n\
1036 The region is highlighted with this face\n\
1037 when Transient Mark mode is enabled and the mark is active.");
1038
1039   defsubr (&Spixmap_spec_p);
1040   defsubr (&Sframe_face_alist);
1041   defsubr (&Sset_frame_face_alist);
1042   defsubr (&Smake_face_internal);
1043   defsubr (&Sset_face_attribute_internal);
1044   defsubr (&Sinternal_next_face_id);
1045 }