From d0316d6264ab0ccbfe7fcb77aae8549a25fc14ff Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 10 May 2021 14:06:37 +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. * 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. * etc/NEWS: Mention the new command and its bindings. --- doc/emacs/display.texi | 11 +++++++++ etc/NEWS | 10 ++++++++ lisp/face-remap.el | 56 +++++++++++++++++++++++++++++++++++++++++- lisp/mwheel.el | 19 +++++++++++++- 4 files changed, 94 insertions(+), 2 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 58d08b43c0..1e499f247c 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -837,6 +837,17 @@ 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-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--} or @kbd{C-x C-M-0}, or scroll the +mouse wheel with the @kbd{Ctrl} and @kbd{Meta} modifiers pressed. + @cindex increase buffer face height @findex text-scale-increase @cindex decrease buffer face height diff --git a/etc/NEWS b/etc/NEWS index c759b333b6..2a1161b75f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -399,6 +399,16 @@ 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-+'; 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. + ** Outline +++ diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 5914ee4a20..f4a52dfb54 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,58 @@ text-scale-adjust (lambda () (interactive) (text-scale-adjust (abs inc)))))) map))))) ;; ) +(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 ?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. + +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 ((event last-command-event) + (echo-keystrokes nil)) + (let* ((key (event-basic-type event)) + (inc + (pcase key + (?+ (* increment 5)) + (?- (* (- increment) 5)) + (?0 (- global-text-scale-adjust--default-height + (face-attribute 'default :height))) + (_ (* increment 5))))) + (let ((frame-inhibit-implied-resize t)) + (set-face-attribute 'default nil :height + (+ (face-attribute 'default :height) inc))) + (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