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


Here is the updated patch with, as discussed, a new user option to control 
the frame resizing, and the additional C-x C-M-= binding.

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

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