]> code.delx.au - gnu-emacs/blobdiff - src/xfaces.c
(mark_byte_stack): Use XMARKBIT and XMARK.
[gnu-emacs] / src / xfaces.c
index 9efdfb4574ec961a748de1908e26e9218f4a60cd..52b9f1b5841a0e15915e55144d8970b2d26ee30b 100644 (file)
@@ -177,9 +177,9 @@ Boston, MA 02111-1307, USA.  */
 
 #define SCALABLE_FONTS 1
 
+#include <config.h>
 #include <sys/types.h>
 #include <sys/stat.h>
-#include <config.h>
 #include "lisp.h"
 #include "charset.h"
 #include "frame.h"
@@ -187,6 +187,10 @@ Boston, MA 02111-1307, USA.  */
 #ifdef HAVE_X_WINDOWS
 #include "xterm.h"
 #include "fontset.h"
+#ifdef USE_MOTIF
+#include <Xm/Xm.h>
+#include <Xm/XmStrDefs.h>
+#endif /* USE_MOTIF */
 #endif
 
 #ifdef MSDOS
@@ -219,7 +223,6 @@ Boston, MA 02111-1307, USA.  */
 #endif /* HAVE_X_WINDOWS */
 
 #include <stdio.h>
-#include <stdlib.h>
 #include <ctype.h>
 #include "keyboard.h"
 
@@ -278,10 +281,26 @@ Lisp_Object Qunspecified;
 
 Lisp_Object Qx_charset_registry;
 
+/* The name of the function to call when the background of the frame
+   has changed, frame_update_face_colors.  */
+
+Lisp_Object Qframe_update_face_colors;
+
 /* Names of basic faces.  */
 
-Lisp_Object Qdefault, Qmodeline, Qtool_bar, Qregion, Qmargin;
-Lisp_Object Qtop_line;
+Lisp_Object Qdefault, Qmode_line, Qtool_bar, Qregion, Qfringe;
+Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
+
+/* The symbol `face-alias'.  A symbols having that property is an
+   alias for another face.  Value of the property is the name of
+   the aliased face.  */
+
+Lisp_Object Qface_alias;
+
+/* Names of frame parameters related to faces.  */
+
+extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
+extern Lisp_Object Qborder_color, Qcursor_color, Qmouse_color;
 
 /* Default stipple pattern used on monochrome displays.  This stipple
    pattern is used on monochrome displays instead of shades of gray
@@ -330,7 +349,7 @@ extern Lisp_Object Qmouse_face;
 
 /* Error symbol for wrong_type_argument in load_pixmap.  */
 
-Lisp_Object Qpixmap_spec_p;
+Lisp_Object Qbitmap_spec_p;
 
 /* Alist of global face definitions.  Each element is of the form
    (FACE . LFACE) where FACE is a symbol naming a face and LFACE
@@ -381,6 +400,7 @@ static int ngcs;
 struct font_name;
 struct table_entry;
 
+static Lisp_Object resolve_face_name P_ ((Lisp_Object));
 static int may_use_scalable_font_p P_ ((struct font_name *, char *));
 static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
 static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
@@ -396,7 +416,6 @@ static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *)
 static char *xstrdup P_ ((char *));
 static unsigned char *xstrlwr P_ ((unsigned char *));
 static void signal_error P_ ((char *, Lisp_Object));
-static void add_to_log P_ ((struct frame *, char *, Lisp_Object, Lisp_Object));
 static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
 static void load_face_font_or_fontset P_ ((struct frame *, struct face *, char *, int));
 static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
@@ -577,71 +596,22 @@ signal_error (s, arg)
 }
 
 
-/* Display a message with format string FORMAT and arguments ARG1 and
-   ARG2 on frame F.  Used to display errors if fonts, bitmaps, colors 
-   etc. for a realized face on frame F cannot be loaded.  (If we would
-   signal an error in these cases, we would end up in an infinite
-   recursion because this would stop realization, and the redisplay
-   triggered by the signal would try to realize that same face again.)
-
-   If basic faces of F are not realized, just add the message to the
-   messages buffer "*Messages*".  Because Fmessage calls
-   echo_area_display which tries to realize basic faces again, we would
-   otherwise also end in an infinite recursion.  */
-
-static void
-add_to_log (f, format, arg1, arg2)
-     struct frame *f;
-     char *format;
-     Lisp_Object arg1, arg2;
-{
-  Lisp_Object args[3];
-  Lisp_Object nargs;
-  Lisp_Object msg;
-  char *buffer;
-  extern int waiting_for_input;
-
-  /* Function note_mouse_highlight calls face_at_buffer_position which
-     may realize a face.  If some attribute of that face is invalid,
-     say an invalid color, don't display an error to avoid calling
-     Lisp from XTread_socket.  */
-  if (waiting_for_input)
-    return;
-
-  nargs = make_number (DIM (args));
-  args[0] = build_string (format);
-  args[1] = arg1;
-  args[2] = arg2;
-  msg = Fformat (nargs, args);
-
-  /* Log the error, but don't display it in the echo area.  This
-     proves to be annoying in many cases.  */
-  buffer = LSTRDUPA (msg);
-  message_dolog (buffer, strlen (buffer), 1, 0);
-}
-
-
-/* If FRAME is nil, return selected_frame.  Otherwise, check that
-   FRAME is a live frame, and return a pointer to it.  NPARAM
-   is the parameter number of FRAME, for CHECK_LIVE_FRAME.  This is
-   here because it's a frequent pattern in Lisp function definitions.  */
+/* If FRAME is nil, return a pointer to the selected frame.
+   Otherwise, check that FRAME is a live frame, and return a pointer
+   to it.  NPARAM is the parameter number of FRAME, for
+   CHECK_LIVE_FRAME.  This is here because it's a frequent pattern in
+   Lisp function definitions.  */
 
 static INLINE struct frame *
 frame_or_selected_frame (frame, nparam)
      Lisp_Object frame;
      int nparam;
 {
-  struct frame *f;
-  
   if (NILP (frame))
-    f = selected_frame;
-  else
-    {
-      CHECK_LIVE_FRAME (frame, nparam);
-      f = XFRAME (frame);
-    }
-
-  return f;
+    frame = selected_frame;
+  
+  CHECK_LIVE_FRAME (frame, nparam);
+  return XFRAME (frame);
 }
 
 \f
@@ -708,9 +678,10 @@ free_frame_faces (f)
 }
 
 
-/* Recompute basic faces for frame F.  Call this after changing frame
-   parameters on which those faces depend, or when realized faces have
-   been freed due to changing attributes of named faces.  */
+/* Clear face caches, and recompute basic faces for frame F.  Call
+   this after changing frame parameters on which those faces depend,
+   or when realized faces have been freed due to changing attributes
+   of named faces. */
 
 void
 recompute_basic_faces (f)
@@ -718,7 +689,9 @@ recompute_basic_faces (f)
 {
   if (FRAME_FACE_CACHE (f))
     {
-      int realized_p = realize_basic_faces (f);
+      int realized_p;
+      clear_face_cache (0);
+      realized_p = realize_basic_faces (f);
       xassert (realized_p);
     }
 }
@@ -864,32 +837,53 @@ clear_font_table (f)
 
 #ifdef HAVE_X_WINDOWS
 
-DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0,
-  "Non-nil if OBJECT is a valid pixmap specification.\n\
-A pixmap specification is either a string, or a list (WIDTH HEIGHT DATA)\n\
-where WIDTH is the pixel width of the pixmap, HEIGHT is its height,\n\
-and DATA contains the bits of the pixmap.")
+DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
+  "Value is non-nil if OBJECT is a valid bitmap specification.\n\
+A bitmap specification is either a string, a file name, or a list\n\
+(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
+HEIGHT is its height, and DATA is a string containing the bits of\n\
+the pixmap.  Bits are stored row by row, each row occupies\n\
+(WIDTH + 7)/8 bytes.")
   (object)
      Lisp_Object object;
 {
-  Lisp_Object height, width;
+  int pixmap_p = 0;
+  
+  if (STRINGP (object))
+    /* If OBJECT is a string, it's a file name.  */
+    pixmap_p = 1;
+  else if (CONSP (object))
+    {
+      /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
+        HEIGHT must be integers > 0, and DATA must be string large
+        enough to hold a bitmap of the specified size.  */
+      Lisp_Object width, height, data;
 
-  return ((STRINGP (object)
-          || (CONSP (object)
-              && CONSP (XCONS (object)->cdr)
-              && CONSP (XCONS (XCONS (object)->cdr)->cdr)
-              && NILP (XCONS (XCONS (XCONS (object)->cdr)->cdr)->cdr)
-              && (width = XCONS (object)->car, INTEGERP (width))
-              && (height = XCONS (XCONS (object)->cdr)->car,
-                  INTEGERP (height))
-              && STRINGP (XCONS (XCONS (XCONS (object)->cdr)->cdr)->car)
-              && XINT (width) > 0
-              && XINT (height) > 0
-              /* The string must have enough bits for width * height.  */
-              && ((XSTRING (XCONS (XCONS (XCONS (object)->cdr)->cdr)->car)->size
-                   * (BITS_PER_INT / sizeof (int)))
-                  >= XFASTINT (width) * XFASTINT (height))))
-         ? Qt : Qnil);
+      height = width = data = Qnil;
+      
+      if (CONSP (object))
+       {
+         width = XCAR (object);
+         object = XCDR (object);
+         if (CONSP (object))
+           {
+             height = XCAR (object);
+             object = XCDR (object);
+             if (CONSP (object))
+               data = XCAR (object);
+           }
+       }
+
+      if (NATNUMP (width) && NATNUMP (height) && STRINGP (data))
+       {
+         int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
+                              / BITS_PER_CHAR);
+         if (STRING_BYTES (XSTRING (data)) >= bytes_per_row * height)
+           pixmap_p = 1;
+       }
+    }
+
+  return pixmap_p ? Qt : Qnil;
 }
 
 
@@ -912,9 +906,9 @@ load_pixmap (f, name, w_ptr, h_ptr)
   if (NILP (name))
     return 0;
 
-  tem = Fpixmap_spec_p (name);
+  tem = Fbitmap_spec_p (name);
   if (NILP (tem))
-    wrong_type_argument (Qpixmap_spec_p, name);
+    wrong_type_argument (Qbitmap_spec_p, name);
 
   BLOCK_INPUT;
   if (CONSP (name))
@@ -940,7 +934,7 @@ load_pixmap (f, name, w_ptr, h_ptr)
 
   if (bitmap_id < 0)
     {
-      add_to_log (f, "Invalid or undefined bitmap %s", name, Qnil);
+      add_to_log ("Invalid or undefined bitmap %s", name, Qnil);
       bitmap_id = 0;
 
       if (w_ptr)
@@ -1058,10 +1052,10 @@ load_face_font_or_fontset (f, face, font_name, fontset)
        }
     }
   else if (fontset >= 0)
-    add_to_log (f, "Unable to load ASCII font of fontset %d",
+    add_to_log ("Unable to load ASCII font of fontset %d",
                make_number (fontset), Qnil);
   else if (font_name)
-    add_to_log (f, "Unable to load font %s",
+    add_to_log ("Unable to load font %s",
                build_string (font_name), Qnil);
 }
 
@@ -1183,7 +1177,7 @@ load_color (f, face, name, target_index)
      to the values in an existing cell. */
   if (!defined_color (f, XSTRING (name)->data, &color, 1))
     {
-      add_to_log (f, "Unable to load color %s", name, Qnil);
+      add_to_log ("Unable to load color %s", name, Qnil);
       
       switch (target_index)
        {
@@ -1260,7 +1254,7 @@ load_face_colors (f, face, attrs)
      "supported" as background because we are supposed to use stipple
      for them.  */
   if (!face_color_supported_p (f, XSTRING (bg)->data, 0)
-      && !NILP (Fpixmap_spec_p (Vface_default_stipple)))
+      && !NILP (Fbitmap_spec_p (Vface_default_stipple)))
     {
       x_destroy_bitmap (f, face->stipple);
       face->stipple = load_pixmap (f, Vface_default_stipple,
@@ -1404,7 +1398,7 @@ load_color (f, face, name, target_index)
       if (INTEGERP (color))
        return (unsigned long)XINT (color);
 
-      add_to_log (f, "Unable to load color %s", name, Qnil);
+      add_to_log ("Unable to load color %s", name, Qnil);
       
       switch (target_index)
        {
@@ -2266,7 +2260,7 @@ font_list (f, pattern, family, registry_and_encoding, fonts)
 
 
 /* Remove elements from LIST whose cars are `equal'.  Called from
-   x-font-list and x-font-family-list to remove duplicate font
+   x-family-fonts and x-font-family-list to remove duplicate font
    entries.  */
 
 static void
@@ -2286,7 +2280,7 @@ remove_duplicates (list)
 }
 
 
-DEFUN ("x-font-list", Fxfont_list, Sx_font_list, 0, 2, 0,
+DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
   "Return a list of available fonts of family FAMILY on FRAME.\n\
 If FAMILY is omitted or nil, list all families.\n\
 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
@@ -2573,7 +2567,7 @@ check_lface_attrs (attrs)
 #ifdef HAVE_WINDOW_SYSTEM
   xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
           || SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
-          || !NILP (Fpixmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
+          || !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
 #endif
 }
 
@@ -2599,12 +2593,40 @@ check_lface (lface)
 #endif /* GLYPH_DEBUG == 0 */
 
 
+/* Resolve face name FACE_NAME.  If FACE_NAME Is a string, intern it
+   to make it a symvol.  If FACE_NAME is an alias for another face,
+   return that face's name.  */
+
+static Lisp_Object
+resolve_face_name (face_name)
+     Lisp_Object face_name;
+{
+  Lisp_Object aliased;
+  
+  if (STRINGP (face_name))
+    face_name = intern (XSTRING (face_name)->data);
+
+  for (;;)
+    {
+      aliased = Fget (face_name, Qface_alias);
+      if (NILP (aliased))
+       break;
+      else
+       face_name = aliased;
+    }
+
+  return face_name;
+}
+
+
 /* Return the face definition of FACE_NAME on frame F.  F null means
    return the global definition.  FACE_NAME may be a string or a
    symbol (apparently Emacs 20.2 allows strings as face names in face
-   text properties; ediff uses that).  If SIGNAL_P is non-zero, signal
-   an error if FACE_NAME is not a valid face name.  If SIGNAL_P is
-   zero, value is nil if FACE_NAME is not a valid face name.  */
+   text properties; ediff uses that).  If FACE_NAME is an alias for
+   another face, return that face's definition.  If SIGNAL_P is
+   non-zero, signal an error if FACE_NAME is not a valid face name.
+   If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
+   name.  */
 
 static INLINE Lisp_Object
 lface_from_face_name (f, face_name, signal_p)
@@ -2614,8 +2636,7 @@ lface_from_face_name (f, face_name, signal_p)
 {
   Lisp_Object lface;
 
-  if (STRINGP (face_name))
-    face_name = intern (XSTRING (face_name)->data);
+  face_name = resolve_face_name (face_name);
 
   if (f)
     lface = assq_no_quit (face_name, f->face_alist);
@@ -2830,7 +2851,7 @@ merge_face_vector_with_property (f, to, prop)
                to[LFACE_BACKGROUND_INDEX] = color_name;
            }
          else
-           add_to_log (f, "Invalid face color", color_name, Qnil);
+           add_to_log ("Invalid face color", color_name, Qnil);
        }
       else if (SYMBOLP (first)
               && *XSYMBOL (first)->name->data == ':')
@@ -2846,14 +2867,14 @@ merge_face_vector_with_property (f, to, prop)
                  if (STRINGP (value))
                    to[LFACE_FAMILY_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face font family", value, Qnil);
+                   add_to_log ("Illegal face font family", value, Qnil);
                }
              else if (EQ (keyword, QCheight))
                {
                  if (INTEGERP (value))
                    to[LFACE_HEIGHT_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face font height", value, Qnil);
+                   add_to_log ("Illegal face font height", value, Qnil);
                }
              else if (EQ (keyword, QCweight))
                {
@@ -2861,7 +2882,7 @@ merge_face_vector_with_property (f, to, prop)
                      && face_numeric_weight (value) >= 0)
                    to[LFACE_WEIGHT_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face weight", value, Qnil);
+                   add_to_log ("Illegal face weight", value, Qnil);
                }
              else if (EQ (keyword, QCslant))
                {
@@ -2869,7 +2890,7 @@ merge_face_vector_with_property (f, to, prop)
                      && face_numeric_slant (value) >= 0)
                    to[LFACE_SLANT_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face slant", value, Qnil);
+                   add_to_log ("Illegal face slant", value, Qnil);
                }
              else if (EQ (keyword, QCunderline))
                {
@@ -2878,7 +2899,7 @@ merge_face_vector_with_property (f, to, prop)
                      || STRINGP (value))
                    to[LFACE_UNDERLINE_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face underline", value, Qnil);
+                   add_to_log ("Illegal face underline", value, Qnil);
                }
              else if (EQ (keyword, QCoverline))
                {
@@ -2887,7 +2908,7 @@ merge_face_vector_with_property (f, to, prop)
                      || STRINGP (value))
                    to[LFACE_OVERLINE_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face overline", value, Qnil);
+                   add_to_log ("Illegal face overline", value, Qnil);
                }
              else if (EQ (keyword, QCstrike_through))
                {
@@ -2896,7 +2917,7 @@ merge_face_vector_with_property (f, to, prop)
                      || STRINGP (value))
                    to[LFACE_STRIKE_THROUGH_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face strike-through", value, Qnil);
+                   add_to_log ("Illegal face strike-through", value, Qnil);
                }
              else if (EQ (keyword, QCbox))
                {
@@ -2908,7 +2929,7 @@ merge_face_vector_with_property (f, to, prop)
                      || NILP (value))
                    to[LFACE_BOX_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face box", value, Qnil);
+                   add_to_log ("Illegal face box", value, Qnil);
                }
              else if (EQ (keyword, QCinverse_video)
                       || EQ (keyword, QCreverse_video))
@@ -2916,30 +2937,30 @@ merge_face_vector_with_property (f, to, prop)
                  if (EQ (value, Qt) || NILP (value))
                    to[LFACE_INVERSE_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face inverse-video", value, Qnil);
+                   add_to_log ("Illegal face inverse-video", value, Qnil);
                }
              else if (EQ (keyword, QCforeground))
                {
                  if (STRINGP (value))
                    to[LFACE_FOREGROUND_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face foreground", value, Qnil);
+                   add_to_log ("Illegal face foreground", value, Qnil);
                }
              else if (EQ (keyword, QCbackground))
                {
                  if (STRINGP (value))
                    to[LFACE_BACKGROUND_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face background", value, Qnil);
+                   add_to_log ("Illegal face background", value, Qnil);
                }
              else if (EQ (keyword, QCstipple))
                {
 #ifdef HAVE_X_WINDOWS
-                 Lisp_Object pixmap_p = Fpixmap_spec_p (value);
+                 Lisp_Object pixmap_p = Fbitmap_spec_p (value);
                  if (!NILP (pixmap_p))
                    to[LFACE_STIPPLE_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face stipple", value, Qnil);
+                   add_to_log ("Illegal face stipple", value, Qnil);
 #endif
                }
              else if (EQ (keyword, QCwidth))
@@ -2948,10 +2969,10 @@ merge_face_vector_with_property (f, to, prop)
                      && face_numeric_swidth (value) >= 0)
                    to[LFACE_SWIDTH_INDEX] = value;
                  else
-                   add_to_log (f, "Illegal face width", value, Qnil);
+                   add_to_log ("Illegal face width", value, Qnil);
                }
              else
-               add_to_log (f, "Invalid attribute %s in face property",
+               add_to_log ("Invalid attribute %s in face property",
                            keyword, Qnil);
 
              prop = XCDR (XCDR (prop));
@@ -2974,7 +2995,7 @@ merge_face_vector_with_property (f, to, prop)
       /* PROP ought to be a face name.  */
       Lisp_Object lface = lface_from_face_name (f, prop, 0);
       if (NILP (lface))
-       add_to_log (f, "Invalid face text property value: %s", prop, Qnil);
+       add_to_log ("Invalid face text property value: %s", prop, Qnil);
       else
        merge_face_vectors (XVECTOR (lface)->contents, to);
     }
@@ -3141,13 +3162,15 @@ frame.")
   CHECK_SYMBOL (face, 0);
   CHECK_SYMBOL (attr, 1);
 
+  face = resolve_face_name (face);
+
   /* Set lface to the Lisp attribute vector of FACE.  */
   if (EQ (frame, Qt))
     lface = lface_from_face_name (NULL, face, 1);
   else
     {
       if (NILP (frame))
-       XSETFRAME (frame, selected_frame);
+       frame = selected_frame;
       
       CHECK_LIVE_FRAME (frame, 3);
       lface = lface_from_face_name (XFRAME (frame), face, 0);
@@ -3355,7 +3378,7 @@ frame.")
 #ifdef HAVE_X_WINDOWS
       if (!UNSPECIFIEDP (value)
          && !NILP (value)
-         && NILP (Fpixmap_spec_p (value)))
+         && NILP (Fbitmap_spec_p (value)))
        signal_error ("Invalid stipple attribute", value);
       old_value = LFACE_STIPPLE (lface);
       LFACE_STIPPLE (lface) = value;
@@ -3382,7 +3405,7 @@ frame.")
 
       CHECK_STRING (value, 3);
       if (EQ (frame, Qt))
-       f = selected_frame;
+       f = SELECTED_FRAME ();
       else
        f = check_x_frame (frame);
       
@@ -3421,14 +3444,61 @@ frame.")
     }
 
 #ifdef HAVE_X_WINDOWS
-  /* Changed font-related attributes of the `default' face are
-     reflected in changed `font' frame parameters.  */
-  if (EQ (face, Qdefault)
-      && !EQ (frame, Qt)
-      && font_related_attr_p
-      && lface_fully_specified_p (XVECTOR (lface)->contents)
+
+  if (!EQ (frame, Qt)
+      && !UNSPECIFIEDP (value)
       && NILP (Fequal (old_value, value)))
-    set_font_frame_param (frame, lface);
+    {
+      Lisp_Object param;
+
+      param = Qnil;
+      
+      if (EQ (face, Qdefault))
+       {
+         /* Changed font-related attributes of the `default' face are
+            reflected in changed `font' frame parameters. */
+         if (font_related_attr_p
+             && lface_fully_specified_p (XVECTOR (lface)->contents))
+           set_font_frame_param (frame, lface);
+         else if (EQ (attr, QCforeground))
+           param = Qforeground_color;
+         else if (EQ (attr, QCbackground))
+           param = Qbackground_color;
+       }
+      else if (EQ (face, Qscroll_bar))
+       {
+         /* Changing the colors of `scroll-bar' sets frame parameters
+            `scroll-bar-foreground' and `scroll-bar-background'. */
+         if (EQ (attr, QCforeground))
+           param = Qscroll_bar_foreground;
+         else if (EQ (attr, QCbackground))
+           param = Qscroll_bar_background;
+       }
+      else if (EQ (face, Qborder))
+       {
+         /* Changing background color of `border' sets frame parameter
+            `border-color'.  */
+         if (EQ (attr, QCbackground))
+           param = Qborder_color;
+       }
+      else if (EQ (face, Qcursor))
+       {
+         /* Changing background color of `cursor' sets frame parameter
+            `cursor-color'.  */
+         if (EQ (attr, QCbackground))
+           param = Qcursor_color;
+       }
+      else if (EQ (face, Qmouse))
+       {
+         /* Changing background color of `mouse' sets frame parameter
+            `mouse-color'.  */
+         if (EQ (attr, QCbackground))
+           param = Qmouse_color;
+       }
+
+      if (SYMBOLP (param))
+       Fmodify_frame_parameters (frame, Fcons (Fcons (param, value), Qnil));
+    }
 
 #endif /* HAVE_X_WINDOWS */
   
@@ -3490,6 +3560,65 @@ set_font_frame_param (frame, lface)
 }
 
 
+/* Update the corresponding face when frame parameter PARAM on frame F
+   has been assigned the value NEW_VALUE.  */
+
+void
+update_face_from_frame_parameter (f, param, new_value)
+     struct frame *f;
+     Lisp_Object param, new_value;
+{
+  Lisp_Object lface;
+
+  /* If there are no faces yet, give up.  This is the case when called
+     from Fx_create_frame, and we do the necessary things later in
+     face-set-after-frame-defaults.  */
+  if (NILP (f->face_alist))
+    return;
+  
+  if (EQ (param, Qforeground_color))
+    {
+      lface = lface_from_face_name (f, Qdefault, 1);
+      LFACE_FOREGROUND (lface) = (STRINGP (new_value)
+                                 ? new_value : Qunspecified);
+      realize_basic_faces (f);
+    }
+  else if (EQ (param, Qbackground_color))
+    {
+      Lisp_Object frame;
+
+      /* Changing the background color might change the background
+        mode, so that we have to load new defface specs.  Call
+        frame-update-face-colors to do that.  */
+      XSETFRAME (frame, f);
+      call1 (Qframe_update_face_colors, frame);
+      
+      lface = lface_from_face_name (f, Qdefault, 1);
+      LFACE_BACKGROUND (lface) = (STRINGP (new_value)
+                                 ? new_value : Qunspecified);
+      realize_basic_faces (f);
+    }
+  if (EQ (param, Qborder_color))
+    {
+      lface = lface_from_face_name (f, Qborder, 1);
+      LFACE_BACKGROUND (lface) = (STRINGP (new_value)
+                                 ? new_value : Qunspecified);
+    }
+  else if (EQ (param, Qcursor_color))
+    {
+      lface = lface_from_face_name (f, Qcursor, 1);
+      LFACE_BACKGROUND (lface) = (STRINGP (new_value)
+                                 ? new_value : Qunspecified);
+    }
+  else if (EQ (param, Qmouse_color))
+    {
+      lface = lface_from_face_name (f, Qmouse, 1);
+      LFACE_BACKGROUND (lface) = (STRINGP (new_value)
+                                 ? new_value : Qunspecified);
+    }
+}
+
+
 /* Get the value of X resource RESOURCE, class CLASS for the display
    of frame FRAME.  This is here because ordinary `x-get-resource'
    doesn't take a frame argument.  */
@@ -3583,6 +3712,211 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource",
 }
 
 
+\f
+/***********************************************************************
+                             Menu face
+ ***********************************************************************/
+
+#ifdef USE_X_TOOLKIT
+
+/* Structure used to pass X resources to functions called via
+   XtApplyToWidgets.  */
+
+struct x_resources
+{
+  Arg *av;
+  int ac;
+};
+
+
+#ifdef USE_MOTIF
+
+static void xm_apply_resources P_ ((Widget, XtPointer));
+static void xm_set_menu_resources_from_menu_face P_ ((struct frame *, Widget));
+
+
+/* Set widget W's X resources from P which points to an x_resources
+   structure.  If W is a cascade button, apply resources to W's
+   submenu.  */
+
+static void
+xm_apply_resources (w, p)
+     Widget w;
+     XtPointer p;
+{
+  Widget submenu = 0;
+  struct x_resources *res = (struct x_resources *) p;
+  
+  XtSetValues (w, res->av, res->ac);
+  XtVaGetValues (w, XmNsubMenuId, &submenu, NULL);
+  if (submenu)
+    {
+      XtSetValues (submenu, res->av, res->ac);
+      XtApplyToWidgets (submenu, xm_apply_resources, p);
+    }
+}
+
+
+/* Set X resources of menu-widget WIDGET on frame F from face `menu'.
+   This is the LessTif/Motif version.  As of LessTif 0.88 it has the
+   following problems:
+
+   1. Setting the XmNfontList resource leads to an infinite loop
+   somewhere in LessTif.  */
+
+static void
+xm_set_menu_resources_from_menu_face (f, widget)
+     struct frame *f;
+     Widget widget;
+{
+  struct face *face;
+  Lisp_Object lface;
+  Arg av[3];
+  int ac = 0;
+  XmFontList fl = 0;
+
+  lface = lface_from_face_name (f, Qmenu, 1);
+  face = FACE_FROM_ID (f, MENU_FACE_ID);
+
+  if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
+    {
+      XtSetArg (av[ac], XmNforeground, face->foreground);
+      ++ac;
+    }
+
+  if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
+    {
+      XtSetArg (av[ac], XmNbackground, face->background);
+      ++ac;
+    }
+
+  /* If any font-related attribute of `menu' is set, set the font.  */
+  if (face->font
+      && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
+         || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
+         || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
+         || !UNSPECIFIEDP (LFACE_SLANT (lface))
+         || !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
+    {
+#if 0 /* Setting the font leads to an infinite loop somewhere
+        in LessTif during geometry computation.  */
+      XmFontListEntry fe;
+      fe = XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT, face->font);
+      fl = XmFontListAppendEntry (NULL, fe);
+      XtSetArg (av[ac], XmNfontList, fl);
+      ++ac;
+#endif
+    }
+
+  xassert (ac <= sizeof av / sizeof *av);
+  
+  if (ac)
+    {
+      struct x_resources res;
+      
+      XtSetValues (widget, av, ac);
+      res.av = av, res.ac = ac;
+      XtApplyToWidgets (widget, xm_apply_resources, &res);
+      if (fl)
+       XmFontListFree (fl);
+    }
+}
+
+
+#endif /* USE_MOTIF */
+
+#ifdef USE_LUCID
+
+static void xl_apply_resources P_ ((Widget, XtPointer));
+static void xl_set_menu_resources_from_menu_face P_ ((struct frame *, Widget));
+
+
+/* Set widget W's resources from P which points to an x_resources
+   structure.  */
+
+static void
+xl_apply_resources (widget, p)
+     Widget widget;
+     XtPointer p;
+{
+  struct x_resources *res = (struct x_resources *) p;
+  XtSetValues (widget, res->av, res->ac);
+}
+
+
+/* On frame F, set X resources of menu-widget WIDGET from face `menu'.
+   This is the Lucid version.  */
+
+static void
+xl_set_menu_resources_from_menu_face (f, widget)
+     struct frame *f;
+     Widget widget;
+{
+  struct face *face;
+  Lisp_Object lface;
+  Arg av[3];
+  int ac = 0;
+
+  lface = lface_from_face_name (f, Qmenu, 1);
+  face = FACE_FROM_ID (f, MENU_FACE_ID);
+
+  if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface)))
+    {
+      XtSetArg (av[ac], XtNforeground, face->foreground);
+      ++ac;
+    }
+
+  if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
+    {
+      XtSetArg (av[ac], XtNbackground, face->background);
+      ++ac;
+    }
+
+  if (face->font
+      && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
+         || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
+         || !UNSPECIFIEDP (LFACE_WEIGHT (lface))
+         || !UNSPECIFIEDP (LFACE_SLANT (lface))
+         || !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
+    {
+      XtSetArg (av[ac], XtNfont, face->font);
+      ++ac;
+    }
+
+  if (ac)
+    {
+      struct x_resources res;
+      
+      XtSetValues (widget, av, ac);
+
+      /* We must do children here in case we're handling a pop-up menu
+        in which case WIDGET is a popup shell.  XtApplyToWidgets
+        is a function from lwlib.  */
+      res.av = av, res.ac = ac;
+      XtApplyToWidgets (widget, xl_apply_resources, &res);
+    }
+}
+
+#endif /* USE_LUCID */
+
+
+/* On frame F, set X resources of menu-widget WIDGET from face `menu'.  */
+
+void
+x_set_menu_resources_from_menu_face (f, widget)
+     struct frame *f;
+     Widget widget;
+{
+#ifdef USE_LUCID
+  xl_set_menu_resources_from_menu_face (f, widget);
+#endif
+#ifdef USE_MOTIF
+  xm_set_menu_resources_from_menu_face (f, widget);
+#endif
+}
+
+#endif /* USE_X_TOOLKIT */
+
 #endif /* HAVE_X_WINDOWS */
 
 
@@ -3609,7 +3943,7 @@ frames).  If FRAME is omitted or nil, use the selected frame.")
   else
     {
       if (NILP (frame))
-       XSETFRAME (frame, selected_frame);
+       frame = selected_frame;
       CHECK_LIVE_FRAME (frame, 2);
       lface = lface_from_face_name (XFRAME (frame), symbol, 1);
     }
@@ -3850,12 +4184,9 @@ If FRAME is omitted or nil, use the selected frame.")
   int i;
 
   if (NILP (frame))
-    f = selected_frame;
-  else
-    {
-      CHECK_LIVE_FRAME (frame, 0);
-      f = XFRAME (frame);
-    }
+    frame = selected_frame;
+  CHECK_LIVE_FRAME (frame, 0);
+  f = XFRAME (frame);
   
   if (EQ (frame, Qt))
     lface = lface_from_face_name (NULL, face, 1);
@@ -5129,10 +5460,15 @@ realize_basic_faces (f)
   
   if (realize_default_face (f))
     {
-      realize_named_face (f, Qmodeline, MODE_LINE_FACE_ID);
+      realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID);
       realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID);
-      realize_named_face (f, Qmargin, BITMAP_AREA_FACE_ID);
-      realize_named_face (f, Qtop_line, TOP_LINE_FACE_ID);
+      realize_named_face (f, Qfringe, BITMAP_AREA_FACE_ID);
+      realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID);
+      realize_named_face (f, Qscroll_bar, SCROLL_BAR_FACE_ID);
+      realize_named_face (f, Qborder, BORDER_FACE_ID);
+      realize_named_face (f, Qcursor, CURSOR_FACE_ID);
+      realize_named_face (f, Qmouse, MOUSE_FACE_ID);
+      realize_named_face (f, Qmenu, MENU_FACE_ID);
       success_p = 1;
     }
 
@@ -5954,7 +6290,7 @@ face_at_buffer_position (w, pos, region_beg, region_end,
    REGION_BEG and REGION_END give the start and end positions of the
    region; both are -1 if no region is visible.  BASE_FACE_ID is the
    id of the basic face to merge with.  It is usually equal to
-   DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or TOP_LINE_FACE_ID
+   DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
    for strings displayed in the mode or top line.
    
    Set *ENDPTR to the next position where to check for faces in
@@ -6097,14 +6433,14 @@ DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, "")
       debug_print (Vface_alternative_font_family_alist);
       fprintf (stderr, "\n");
        
-      for (i = 0; i < FRAME_FACE_CACHE (selected_frame)->used; ++i)
+      for (i = 0; i < FRAME_FACE_CACHE (SELECTED_FRAME ())->used; ++i)
        Fdump_face (make_number (i));
     }
   else
     {
       struct face *face;
       CHECK_NUMBER (n, 0);
-      face = FACE_FROM_ID (selected_frame, XINT (n));
+      face = FACE_FROM_ID (SELECTED_FRAME (), XINT (n));
       if (face == NULL)
        error ("Not a valid face");
       dump_realized_face (face);
@@ -6137,9 +6473,11 @@ syms_of_xfaces ()
 {
   Qface = intern ("face");
   staticpro (&Qface);
-  Qpixmap_spec_p = intern ("pixmap-spec-p");
-  staticpro (&Qpixmap_spec_p);
-
+  Qbitmap_spec_p = intern ("bitmap-spec-p");
+  staticpro (&Qbitmap_spec_p);
+  Qframe_update_face_colors = intern ("frame-update-face-colors");
+  staticpro (&Qframe_update_face_colors);
+  
   /* Lisp face attribute keywords.  */
   QCfamily = intern (":family");
   staticpro (&QCfamily);
@@ -6238,18 +6576,30 @@ syms_of_xfaces ()
 
   Qx_charset_registry = intern ("x-charset-registry");
   staticpro (&Qx_charset_registry);
+  Qface_alias = intern ("face-alias");
+  staticpro (&Qface_alias);
   Qdefault = intern ("default");
   staticpro (&Qdefault);
-  Qmodeline = intern ("modeline");
-  staticpro (&Qmodeline);
+  Qmode_line = intern ("mode-line");
+  staticpro (&Qmode_line);
   Qtool_bar = intern ("tool-bar");
   staticpro (&Qtool_bar);
   Qregion = intern ("region");
   staticpro (&Qregion);
-  Qmargin = intern ("margin");
-  staticpro (&Qmargin);
-  Qtop_line = intern ("top-line");
-  staticpro (&Qtop_line);
+  Qfringe = intern ("fringe");
+  staticpro (&Qfringe);
+  Qheader_line = intern ("header-line");
+  staticpro (&Qheader_line);
+  Qscroll_bar = intern ("scroll-bar");
+  staticpro (&Qscroll_bar);
+  Qmenu = intern ("menu");
+  staticpro (&Qmenu);
+  Qcursor = intern ("cursor");
+  staticpro (&Qcursor);
+  Qborder = intern ("border");
+  staticpro (&Qborder);
+  Qmouse = intern ("mouse");
+  staticpro (&Qmouse);
 
   defsubr (&Sinternal_make_lisp_face);
   defsubr (&Sinternal_lisp_face_p);
@@ -6315,10 +6665,10 @@ scaled if its name matches a regular expression in the list.");
 #endif /* SCALABLE_FONTS */
 
 #ifdef HAVE_X_WINDOWS
-  defsubr (&Spixmap_spec_p);
+  defsubr (&Sbitmap_spec_p);
   defsubr (&Sx_list_fonts);
   defsubr (&Sinternal_face_x_get_resource);
-  defsubr (&Sx_font_list);
+  defsubr (&Sx_family_fonts);
   defsubr (&Sx_font_family_list);
 #endif /* HAVE_X_WINDOWS */