Commit fce3fdeb authored by Chong Yidong's avatar Chong Yidong

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.
parent a037c171
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.
......
......@@ -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.
......
......@@ -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.
......
......@@ -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."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment