From fce3fdeb947e51656675129592c8514be32b46bf Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Tue, 31 Jan 2012 16:38:58 +0800 Subject: [PATCH] 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. --- lisp/ChangeLog | 9 ++++++ lisp/faces.el | 11 ++++--- lisp/frame.el | 84 +++++++++++++++++++++++++++++++++++------------- lisp/menu-bar.el | 27 +++------------- 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 + + * 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 * 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." -- 2.39.2