master e0488f89d1: Command for global adjustments to the default face

[Lars Ingebrigtsen]

branch: master
commit e0488f89d1712ce905f9040e6b26fdf0a4a0666d
Author: Gregory Heytings <gregory@heytings.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Command for 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     | 80 +++++++++++++++++++++++++++++++++++++++++++++++++-
 lisp/mwheel.el         | 20 ++++++++++++-
 4 files changed, 126 insertions(+), 2 deletions(-)

diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index fbff1d4eb6..5e4728c8da 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -893,6 +893,22 @@ of 1.2; to change this factor, customize the variable
 to the @code{text-scale-adjust} command restores the default height,
 the same as typing @kbd{C-x C-0}.
 
+@cindex ajust global font size
+@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 sizes of the fonts 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 font size is changed
+globally, customize the variable
+@code{global-text-scale-adjust-resizes-frames} (@pxref{Easy
+Customization}).
+
 @cindex increase buffer font size
 @findex text-scale-increase
 @cindex decrease buffer font size
diff --git a/etc/NEWS b/etc/NEWS
index 4b3a02b2e0..773e0849c2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -324,6 +324,18 @@ startup.  Previously, these functions ignored
 
 * Changes in Emacs 29.1
 
++++
+** New command to change the fond sized globally.
+To increase the font size, type 'C-x C-M-+' or 'C-x C-M-='; to
+decrease it, type 'C-x C-M--'; to restore the font size, 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 font size by three steps.  When
+mouse-wheel-mode is enabled, 'C-M-wheel-up' and 'C-M-wheel-down' also
+increase and decrease the font size globally.  Additionally, the
+variable 'global-text-scale-adjust-resizes-frames' controls whether
+the frames are resized when the font size is changed.
+
 ** New config variable 'syntax-wholeline-max' to reduce the cost of long lines.
 This variable is used by some operations (mostly syntax-propertization
 and font-locking) to treat lines longer than this variable as if they
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index d611671408..bfc138b043 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -394,7 +394,9 @@ a top-level keymap, `text-scale-increase' or
 Most faces are affected by these font size changes, but not faces
 that have an explicit `:height' setting.  The two exceptions to
 this are the `default' and `header-line' faces: they will both be
-scaled even if they have an explicit `:height' setting."
+scaled even if they have an explicit `:height' setting.
+
+See also the related command `global-text-scale-adjust'."
   (interactive "p")
   (let ((ev last-command-event)
        (echo-keystrokes nil))
@@ -445,6 +447,82 @@ scaled even if they have an explicit `:height' setting."
        (+ text-scale--pinch-start-scale
           (round (log scale text-scale-mode-step)))))))
 
+(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")
+
+(defcustom global-text-scale-adjust-limits '(10 . 500)
+  "Min/max values for `global-text-scale-adjust'.
+This is a cons cell where the `car' has the minimum font size and
+the `cdr' has the max font size."
+  :version "29.1"
+  :group 'display
+  :type '(cons (integer :tag "Min")
+               (integer :tag "Max")))
+
+(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 font size by INCREMENT.
+
+Interactively, 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 font size as long as the key,
+with all modifiers removed, is one of the above characters.
+
+Buffer-local face adjustements have higher priority than global
+face adjustments.
+
+The variable `global-text-scale-adjust-resizes-frames' controls
+whether the frames are resized to keep the same number of lines
+and characters per line when the font size 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 (< (car global-text-scale-adjust-limits)
+               new
+               (cdr global-text-scale-adjust-limits))
+        (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))))))
+
 
 ;; ----------------------------------------------------------------
 ;; buffer-face-mode
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 9a92d42cc0..7963eaf4a4 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -41,6 +41,17 @@
 (require 'timer)
 
 (defvar mouse-wheel-mode)
+
+(defun mouse-wheel-global-text-scale (event)
+  "Increase or decrease the global font size 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.")
 
@@ -113,7 +124,10 @@ set to the event sent when clicking on the mouse wheel 
button."
   :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.
@@ -489,6 +503,10 @@ an event used for scrolling, such as 
`mouse-wheel-down-event'."
         (when 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