bug#48307: Feature request: provide default keybindings to change the font size in all windows

[Gregory Heytings <gregory@heytings.org>]

[-- Attachment #1: Type: text/plain, Size: 108 bytes --]


Updated patch attached.  The main added feature is that face resizing is 
now bounded (between 10 and 500).

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-diff; name=Global-adjustments-to-the-default-face.patch, Size: 8716 bytes --]

From d47e46a0108aa3499cdf4ff61da5134650a96818 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Tue, 25 May 2021 07:56:38 +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 5fccdaa834..01121ffee6 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 e11b860616..c5c4a93d90 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -416,6 +416,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 modifiers, 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..5e136e368b 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' 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)
+           (cur (face-attribute 'default :height))
+           (inc
+            (pcase key
+              (?- (* (- increment) 5))
+              (?0 (- global-text-scale-adjust--default-height cur))
+              (_ (* increment 5))))
+           (new (+ cur inc)))
+      (when (< 10 new 500)
+        (let ((frame-inhibit-implied-resize
+               (not global-text-scale-adjust-resizes-frames)))
+          (set-face-attribute 'default nil :height new)))
+      (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))))))
+
 \f
 ;; ----------------------------------------------------------------
 ;; buffer-face-mode
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index b31805a575..8fb38c3d84 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.
@@ -380,6 +383,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.")
 
@@ -436,6 +449,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