summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorChong Yidong <cyd@gnu.org>2012-01-31 16:38:58 +0800
committerChong Yidong <cyd@gnu.org>2012-01-31 16:38:58 +0800
commitfce3fdeb947e51656675129592c8514be32b46bf (patch)
tree513a00667048d111fd309b587cebcdd5749fa376 /lisp
parenta037c17168419db7f5054a3ba080b94b9298c1a9 (diff)
downloademacs-fce3fdeb947e51656675129592c8514be32b46bf.tar.gz
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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/faces.el11
-rw-r--r--lisp/frame.el84
-rw-r--r--lisp/menu-bar.el27
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."