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: 269 bytes --]


Thanks for mentioning frame-inhibit-implied-resize, I did not know it 
exists.

I attach a patch that does, I believe, what Clément has in mind. 
Comments and feedback welcome.

Note that this patch can't be applied yet, my paperwork is still not 
finished :(

[-- Attachment #2: Type: text/x-diff, Size: 7718 bytes --]

From d0316d6264ab0ccbfe7fcb77aae8549a25fc14ff Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
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))))))
+
 \f
 ;; ----------------------------------------------------------------
 ;; 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