[Emacs-diffs] /srv/bzr/emacs/trunk r107030: Fix menu-set-font interaction with Custom themes.

[Chong Yidong]

------------------------------------------------------------
revno: 107030
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Tue 2012-01-31 16:38:58 +0800
message:
  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.
modified:
  lisp/ChangeLog
  lisp/faces.el
  lisp/frame.el
  lisp/menu-bar.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-01-31 04:50:04 +0000
+++ b/lisp/ChangeLog    2012-01-31 08:38:58 +0000
@@ -1,3 +1,12 @@
+2012-01-31  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * progmodes/cwarn.el (cwarn): Remove dead link.

=== modified file 'lisp/faces.el'
--- a/lisp/faces.el     2012-01-19 07:21:25 +0000
+++ b/lisp/faces.el     2012-01-31 08:38:58 +0000
@@ -1513,11 +1513,12 @@
 
 (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.

=== modified file 'lisp/frame.el'
--- a/lisp/frame.el     2012-01-29 14:22:51 +0000
+++ b/lisp/frame.el     2012-01-31 08:38:58 +0000
@@ -1052,15 +1052,22 @@
                   (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 @@
                                 (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.

=== modified file 'lisp/menu-bar.el'
--- a/lisp/menu-bar.el  2012-01-19 07:21:25 +0000
+++ b/lisp/menu-bar.el  2012-01-31 08:38:58 +0000
@@ -683,29 +683,10 @@
 (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."