From e1d50941106519fd0b2ad97adbd66cb4ee9c621b Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 10 May 2021 19:28:43 +0000 Subject: [PATCH] Global adjustments to the default face * lisp/face-remap.el (global-text-scale-adjust): New command. (text-scale-adjust): Refer to the new related command. (global-text-scale-adjust-resizes-frames): New user option. * lisp/mwheel.el (mouse-wheel-scroll-amount): Add the new command to the mouse wheel scrolling events. (mouse-wheel-global-text-scale): New function. (mouse-wheel-mode): Use the new function with mouse-wheel-mode. * doc/emacs/display.texi (Text Scale): Document the new command and the new user option. * etc/NEWS: Mention the new command and its bindings, and the new user option. --- doc/emacs/display.texi | 16 ++++++++++ etc/NEWS | 12 ++++++++ lisp/face-remap.el | 68 +++++++++++++++++++++++++++++++++++++++++- lisp/mwheel.el | 19 +++++++++++- 4 files changed, 113 insertions(+), 2 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 58d08b43c0..44c27e7db8 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -837,6 +837,22 @@ Text Scale to the @code{text-scale-adjust} command restores the default height, the same as typing @kbd{C-x C-0}. +@cindex ajust global face height +@findex global-text-scale-adjust +@kindex C-x C-M-+ +@kindex C-x C-M-= +@kindex C-x C-M-- +@kindex C-x C-M-0 +@kindex C-M-wheel-down +@kindex C-M-wheel-up + Similarly, to change the height of the default face globally, type +@kbd{C-x C-M-+}, @kbd{C-x C-M-=}, @kbd{C-x C-M--} or @kbd{C-x C-M-0}, +or scroll the mouse wheel with both the @kbd{Ctrl} and @kbd{Meta} +modifiers pressed. To enable frame resizing when the height of the +default face is changed globally, customize the variable +@code{global-text-scale-adjust-resizes-frames} (@pxref{Easy +Customization}). + @cindex increase buffer face height @findex text-scale-increase @cindex decrease buffer face height diff --git a/etc/NEWS b/etc/NEWS index c759b333b6..7f7a0d8669 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -399,6 +399,18 @@ When this option is set, direction changes in Isearch move to another search match, if there is one, instead of moving point to the other end of the current match. ++++ +** New command to change the default face height globally. +To increase it, type 'C-x C-M-+' or 'C-x C-M-='; to decrease it, type +'C-x C-M--'; to restore the default face height, type 'C-x C-M-0'. +The final key in these commands may be repeated without the leading +'C-x' and without the modifier, e.g. 'C-x C-M-+ C-M-+ C-M-+' and 'C-x +C-M-+ + +' increase the default face height by three steps. When +mouse-wheel-mode is enabled, 'C-M-wheel-up' and 'C-M-wheel-down' also +increase and decrease the default face height globally. Additionally, +the variable 'global-text-scale-adjust-resizes-frames' controls +whether the frames are resized when the default face height is changed. + ** Outline +++ diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 5914ee4a20..eae2bfc3c7 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -371,7 +371,9 @@ text-scale-adjust `text-scale-increase' command which makes repetition convenient even when it is bound in a non-top-level keymap. For binding in a top-level keymap, `text-scale-increase' or -`text-scale-decrease' may be more appropriate." +`text-scale-decrease' may be more appropriate. + +See also the related command `global-text-scale-adjust'." (interactive "p") (let ((ev last-command-event) (echo-keystrokes nil)) @@ -393,6 +395,70 @@ text-scale-adjust (lambda () (interactive) (text-scale-adjust (abs inc)))))) map))))) ;; ) +(defcustom global-text-scale-adjust-resizes-frames nil + "Whether `global-text-scale-adjust' resizes the frames." + :type '(choice (const :tag "Off" nil) + (const :tag "On" t)) + :group 'display + :version "28.1") + +(defvar global-text-scale-adjust--default-height nil) + +;;;###autoload (define-key ctl-x-map [(control meta ?+)] 'global-text-scale-adjust) +;;;###autoload (define-key ctl-x-map [(control meta ?=)] 'global-text-scale-adjust) +;;;###autoload (define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust) +;;;###autoload (define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust) +;;;###autoload +(defun global-text-scale-adjust (increment) + "Globally adjust the height of the default face by INCREMENT. + +INCREMENT may be passed as a numeric prefix argument. + +The adjustment made depends on the final component of the key binding +used to invoke the command, with all modifiers removed: + + +, = Globally increase the height of the default face + - Globally decrease the height of the default face + 0 Globally reset the height of the default face + +After adjusting, further adjust the default face height as long as the +key, with all modifiers removed, is one of the above characters. + +Buffer-local face adjustements remain in effect when global face +adjustments are made. + +The variable `global-text-scale-adjust-resizes-frames', which controls +whether the frames are resized when the default face is adjusted. + +See also the related command `text-scale-adjust'." + (interactive "p") + (when (display-graphic-p) + (unless global-text-scale-adjust--default-height + (setq global-text-scale-adjust--default-height + (face-attribute 'default :height))) + (let* ((key (event-basic-type last-command-event)) + (echo-keystrokes nil) + (inc + (pcase key + ((or ?+ ?=) (* increment 5)) + (?- (* (- increment) 5)) + (?0 (- global-text-scale-adjust--default-height + (face-attribute 'default :height))) + (_ (* increment 5))))) + (let ((frame-inhibit-implied-resize + (not global-text-scale-adjust-resizes-frames))) + (set-face-attribute 'default nil :height + (+ (face-attribute 'default :height) inc))) + (when (characterp key) + (message "Use +,-,0 for further adjustment") + (set-transient-map + (let ((map (make-sparse-keymap))) + (dolist (mod '(() (control meta))) + (dolist (key '(?+ ?= ?- ?0)) + (define-key map (vector (append mod (list key))) + 'global-text-scale-adjust))) + map)))))) + ;; ---------------------------------------------------------------- ;; buffer-face-mode diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 048f50c772..d5944fef7e 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -84,7 +84,10 @@ mouse-wheel-inhibit-click-time :type 'number) (defcustom mouse-wheel-scroll-amount - '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale)) + '(1 ((shift) . hscroll) + ((meta) . nil) + ((control meta) . global-text-scale) + ((control) . text-scale)) "Amount to scroll windows by when spinning the mouse wheel. This is an alist mapping the modifier key to the amount to scroll when the wheel is moved with the modifier key depressed. @@ -377,6 +380,16 @@ mouse-wheel-text-scale (text-scale-decrease 1))) (select-window selected-window)))) +(defun mouse-wheel-global-text-scale (event) + "Increase or decrease the global height of the default face according to the EVENT." + (interactive (list last-input-event)) + (let ((button (mwheel-event-button event))) + (unwind-protect + (cond ((eq button mouse-wheel-down-event) + (global-text-scale-adjust 1)) + ((eq button mouse-wheel-up-event) + (global-text-scale-adjust -1)))))) + (defvar mouse-wheel--installed-bindings-alist nil "Alist of all installed mouse wheel key bindings.") @@ -433,6 +446,10 @@ mouse-wheel-mode (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) (mouse-wheel--add-binding `[,(list (caar binding) event)] 'mouse-wheel-text-scale))) + ((and (consp binding) (eq (cdr binding) 'global-text-scale)) + (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) + (mouse-wheel--add-binding `[,(append (car binding) (list event))] + 'mouse-wheel-global-text-scale))) ;; Bindings for scrolling. (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event -- 2.30.2