Fix menu-set-font interaction with Custom themes.

In particular, prevent it from setting non-font-related attributes
like the foreground and background color.  This requires a bugfix to
face-spec-reset-face to make "resetting" the default face work.

* lisp/faces.el (face-spec-reset-face): Don't apply unspecified
attribute values to the default face.

* lisp/frame.el (set-frame-font): New arg ALL-FRAMES.

* lisp/menu-bar.el (menu-set-font): Use set-frame-font.

4 files changed, 81 insertions, 50 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9ba62b56449..ad25d537f2b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2012-01-31  Chong Yidong  <cyd@gnu.org>
+
+        * frame.el (set-frame-font): New arg ALL-FRAMES.
+
+        * menu-bar.el (menu-set-font): Use set-frame-font.
+
+        * faces.el (face-spec-reset-face): Don't apply unspecified
+        attribute values to the default face.
+
 2012-01-31  Juanma Barranquero  <lekktu@gmail.com>
 
         * progmodes/cwarn.el (cwarn): Remove dead link.
diff --git a/lisp/faces.el b/lisp/faces.el
index 5d406ad7c0b..cd7f92bfad4 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1513,11 +1513,12 @@ If SPEC is nil, return nil."
 
 (defun face-spec-reset-face (face &optional frame)
   "Reset all attributes of FACE on FRAME to unspecified."
-  (let (reset-args)
-    (dolist (attr-and-name face-attribute-name-alist)
-      (push 'unspecified reset-args)
-      (push (car attr-and-name) reset-args))
-    (apply 'set-face-attribute face frame reset-args)))
+  (unless (eq face 'default)
+    (let (reset-args)
+      (dolist (attr-and-name face-attribute-name-alist)
+        (push 'unspecified reset-args)
+        (push (car attr-and-name) reset-args))
+      (apply 'set-face-attribute face frame reset-args))))
 
 (defun face-spec-set (face spec &optional for-defface)
   "Set FACE's face spec, which controls its appearance, to SPEC.
diff --git a/lisp/frame.el b/lisp/frame.el
index 392613defd6..cf9c09b24ae 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1052,15 +1052,22 @@ If FRAME is omitted, describe the currently selected frame."
                   (pattern &optional face frame maximum width))
 
 (define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1")
-(defun set-frame-font (font-name &optional keep-size)
-  "Set the font of the selected frame to FONT-NAME.
-When called interactively, prompt for the name of the font to use.
-To get the frame's current default font, use `frame-parameters'.
-
-The default behavior is to keep the numbers of lines and columns in
-the frame, thus may change its pixel size.  If optional KEEP-SIZE is
-non-nil (interactively, prefix argument) the current frame size (in
-pixels) is kept by adjusting the numbers of the lines and columns."
+
+(defun set-frame-font (font-name &optional keep-size all-frames)
+  "Set the default font to FONT-NAME.
+When called interactively, prompt for the name of a font, and use
+that font on the selected frame.
+
+If KEEP-SIZE is nil, keep the number of frame lines and columns
+fixed.  If KEEP-SIZE is non-nil (or with a prefix argument), try
+to keep the current frame size fixed (in pixels) by adjusting the
+number of lines and columns.
+
+If ALL-FRAMES is nil, apply the font to the selected frame only.
+If ALL-FRAMES is non-nil, apply the font to all frames; in
+addition, alter the user's Customization settings as though the
+font-related attributes of the `default' face had been \"set in
+this session\", so that the font is applied to future frames."
   (interactive
    (let* ((completion-ignore-case t)
           (font (completing-read "Font name: "
@@ -1069,19 +1076,52 @@ pixels) is kept by adjusting the numbers of the lines and columns."
                                  (x-list-fonts "*" nil (selected-frame))
                                  nil nil nil nil
                                  (frame-parameter nil 'font))))
-     (list font current-prefix-arg)))
-  (let (fht fwd)
-    (if keep-size
-        (setq fht (* (frame-parameter nil 'height) (frame-char-height))
-              fwd (* (frame-parameter nil 'width)  (frame-char-width))))
-    (modify-frame-parameters (selected-frame)
-                             (list (cons 'font font-name)))
-    (if keep-size
-        (modify-frame-parameters
-         (selected-frame)
-         (list (cons 'height (round fht (frame-char-height)))
-               (cons 'width (round fwd (frame-char-width)))))))
-  (run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
+     (list font current-prefix-arg nil)))
+  (when (stringp font-name)
+    (let* ((this-frame (selected-frame))
+           (frames (if all-frames (frame-list) (list this-frame)))
+           height width)
+      (dolist (f frames)
+        (when (display-multi-font-p f)
+          (if keep-size
+              (setq height (* (frame-parameter f 'height)
+                              (frame-char-height f))
+                    width  (* (frame-parameter f 'width)
+                              (frame-char-width f))))
+          ;; When set-face-attribute is called for :font, Emacs
+          ;; guesses the best font according to other face attributes
+          ;; (:width, :weight, etc.) so reset them too (Bug#2476).
+          (set-face-attribute 'default f
+                              :width 'normal :weight 'normal
+                              :slant 'normal :font font-name)
+          (if keep-size
+              (modify-frame-parameters
+               f
+               (list (cons 'height (round height (frame-char-height f)))
+                     (cons 'width  (round width  (frame-char-width f))))))))
+      (when all-frames
+        ;; Alter the user's Custom setting of the `default' face, but
+        ;; only for font-related attributes.
+        (let ((specs (cadr (assq 'user (get 'default 'theme-face))))
+              (attrs '(:family :foundry :slant :weight :height :width))
+              (new-specs nil))
+          (if (null specs) (setq specs '((t nil))))
+          (dolist (spec specs)
+            ;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST)
+            (let ((display (nth 0 spec))
+                  (plist   (copy-tree (nth 1 spec))))
+              ;; Alter only DISPLAY conditions matching this frame.
+              (when (or (memq display '(t default))
+                        (face-spec-set-match-display display this-frame))
+                (dolist (attr attrs)
+                  (setq plist (plist-put plist attr
+                                         (face-attribute 'default attr)))))
+              (push (list display plist) new-specs)))
+          (setq new-specs (nreverse new-specs))
+          (put 'default 'customized-face new-specs)
+          (custom-push-theme 'theme-face 'default 'user 'set new-specs)
+          (put 'default 'face-modified nil))))
+    (run-hooks 'after-setting-font-hook 'after-setting-font-hooks)))
 
 (defun set-frame-parameter (frame parameter value)
   "Set frame parameter PARAMETER to VALUE on FRAME.
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 7e54a9762ec..1f57601a711 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -683,29 +683,10 @@ by \"Save Options\" in Custom buffers.")
 (defun menu-set-font ()
   "Interactively select a font and make it the default."
   (interactive)
-  (let ((font (if (fboundp 'x-select-font)
-                  (x-select-font)
-                (mouse-select-font)))
-        spec)
-    (when font
-      ;; Be careful here: when set-face-attribute is called for the
-      ;; :font attribute, Emacs tries to guess the best matching font
-      ;; by examining the other face attributes (Bug#2476).
-      (set-face-attribute 'default (selected-frame)
-                          :width 'normal
-                          :weight 'normal
-                          :slant 'normal
-                          :font font)
-      (let ((font-object (face-attribute 'default :font)))
-        (dolist (f (frame-list))
-          (and (not (eq f (selected-frame)))
-               (display-graphic-p f)
-               (set-face-attribute 'default f :font font-object)))
-        (set-face-attribute 'default t :font font-object))
-      (setq spec (list (list t (face-attr-construct 'default))))
-      (put 'default 'customized-face spec)
-      (custom-push-theme 'theme-face 'default 'user 'set spec)
-      (put 'default 'face-modified nil))))
+  (set-frame-font (if (fboundp 'x-select-font)
+                      (x-select-font)
+                    (mouse-select-font))
+                  nil t))
 
 (defun menu-bar-options-save ()
   "Save current values of Options menu items using Custom."