bug#28182: maybe implement CTRL++ to zoom text

[Stefan Kangas <stefan@marxist.se>]

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

Eli Zaretskii <eliz@gnu.org> writes:

> Please don't forget mentioning this in NEWS (and in the manual, if
> applicable).

Thanks.  Is something like the attached okay?  I'm not sure exactly
what you had in mind, since this mostly preserves previous behaviour
also for changing the font size.

(I checked the manual, but it is fine as is, IMO.)

Best regards,
Stefan Kangas

[-- Attachment #2: 0001-Change-font-size-in-correct-window-using-mouse-wheel.patch --]
[-- Type: text/x-patch, Size: 6993 bytes --]

From 01cac92927782e889c6e65dc0df70733e9ffa12f Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Tue, 8 Oct 2019 23:53:14 +0200
Subject: [PATCH] Change font size in correct window using mouse wheel

* lisp/mwheel.el (mouse-wheel--get-scroll-window): New function
extracted from...
(mwheel-scroll): ...here.
(mouse-wheel-text-scale): New function to change face height in
the correct window, depending on the value of
'mouse-wheel-follows-mouse'.  (Bug#28182)
(mouse-wheel-mode): Bind 'mouse-wheel-text-scale' instead of
'text-scale-increase' and 'text-scale-decrease'.
---
 etc/NEWS       |  5 ++++
 lisp/mwheel.el | 80 +++++++++++++++++++++++++++++++-------------------
 2 files changed, 54 insertions(+), 31 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 2ca681ff9b..53b9c1eec2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2335,6 +2335,11 @@ To get the old behaviour back, customize the variable
 (customize-set-variable 'mouse-wheel-scroll-amount
                         '(5 ((shift) . 1) ((control) . nil)))
 
+By default, the font size will be changed in the window that the mouse
+pointer is over.  To change this behaviour, you can customize the
+option 'mouse-wheel-follow-mouse'.  Note that this will also affect
+scrolling.
+
 \f
 * Lisp Changes in Emacs 27.1
 
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 9b67e71886..8c1927950a 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -137,7 +137,8 @@ mouse-wheel-progressive-speed
 
 (defcustom mouse-wheel-follow-mouse t
   "Whether the mouse wheel should scroll the window that the mouse is over.
-This can be slightly disconcerting, but some people prefer it."
+This affects both the commands for scrolling and changing the
+face height."
   :group 'mouse
   :type 'boolean)
 
@@ -210,34 +211,40 @@ mouse-wheel-right-event
     (intern "mouse-7"))
   "Event used for scrolling right.")
 
+(defun mouse-wheel--get-scroll-window (event)
+  "Return window for mouse wheel event EVENT.
+If `mouse-wheel-follow-mouse' is non-nil, return the window that
+the mouse pointer is over.  Otherwise, return the currently
+active window."
+  (or (catch 'found
+        (let* ((window (if mouse-wheel-follow-mouse
+                           (mwheel-event-window event)
+                         (selected-window)))
+               (frame (when (window-live-p window)
+                        (frame-parameter
+                         (window-frame window) 'mouse-wheel-frame))))
+          (when (frame-live-p frame)
+            (let* ((pos (mouse-absolute-pixel-position))
+                   (pos-x (car pos))
+                   (pos-y (cdr pos)))
+              (walk-window-tree
+               (lambda (window-1)
+                 (let ((edges (window-edges window-1 nil t t)))
+                   (when (and (<= (nth 0 edges) pos-x)
+                              (<= pos-x (nth 2 edges))
+                              (<= (nth 1 edges) pos-y)
+                              (<= pos-y (nth 3 edges)))
+                     (throw 'found window-1))))
+               frame nil t)))))
+      (mwheel-event-window event)))
+
 (defun mwheel-scroll (event)
   "Scroll up or down according to the EVENT.
 This should be bound only to mouse buttons 4, 5, 6, and 7 on
 non-Windows systems."
   (interactive (list last-input-event))
   (let* ((selected-window (selected-window))
-         (scroll-window
-          (or (catch 'found
-                (let* ((window (if mouse-wheel-follow-mouse
-                                   (mwheel-event-window event)
-                                 (selected-window)))
-                       (frame (when (window-live-p window)
-                                (frame-parameter
-                                 (window-frame window) 'mouse-wheel-frame))))
-                  (when (frame-live-p frame)
-                    (let* ((pos (mouse-absolute-pixel-position))
-                           (pos-x (car pos))
-                           (pos-y (cdr pos)))
-                      (walk-window-tree
-                       (lambda (window-1)
-                         (let ((edges (window-edges window-1 nil t t)))
-                           (when (and (<= (nth 0 edges) pos-x)
-                                      (<= pos-x (nth 2 edges))
-                                      (<= (nth 1 edges) pos-y)
-                                      (<= pos-y (nth 3 edges)))
-                             (throw 'found window-1))))
-                       frame nil t)))))
-              (mwheel-event-window event)))
+         (scroll-window (mouse-wheel--get-scroll-window event))
 	 (old-point
           (and (eq scroll-window selected-window)
 	       (eq (car-safe transient-mark-mode) 'only)
@@ -322,6 +329,20 @@ mwheel-scroll
 
 (put 'mwheel-scroll 'scroll-command t)
 
+(defun mouse-wheel-text-scale (event)
+  "Increase or decrease the height of the default face according to the EVENT."
+  (interactive (list last-input-event))
+  (let ((selected-window (selected-window))
+        (scroll-window (mouse-wheel--get-scroll-window event))
+        (button (mwheel-event-button event)))
+    (select-window scroll-window 'mark-for-redisplay)
+    (unwind-protect
+        (cond ((eq button mouse-wheel-down-event)
+               (text-scale-decrease 1))
+              ((eq button mouse-wheel-up-event)
+               (text-scale-increase 1)))
+      (select-window selected-window))))
+
 (defvar mwheel-installed-bindings nil)
 (defvar mwheel-installed-text-scale-bindings nil)
 
@@ -347,8 +368,7 @@ mouse-wheel-mode
   (mouse-wheel--remove-bindings mwheel-installed-bindings
                                 '(mwheel-scroll))
   (mouse-wheel--remove-bindings mwheel-installed-text-scale-bindings
-                                '(text-scale-increase
-                                  text-scale-decrease))
+                                '(mouse-wheel-text-scale))
   (setq mwheel-installed-bindings nil)
   (setq mwheel-installed-text-scale-bindings nil)
   ;; Setup bindings as needed.
@@ -357,12 +377,10 @@ mouse-wheel-mode
       (cond
        ;; Bindings for changing font size.
        ((and (consp binding) (eq (cdr binding) 'text-scale))
-        (let ((increase-key `[,(list (caar binding) mouse-wheel-down-event)])
-              (decrease-key `[,(list (caar binding) mouse-wheel-up-event)]))
-          (global-set-key increase-key 'text-scale-increase)
-          (global-set-key decrease-key 'text-scale-decrease)
-          (push increase-key mwheel-installed-text-scale-bindings)
-          (push decrease-key mwheel-installed-text-scale-bindings)))
+        (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
+          (let ((key `[,(list (caar binding) event)]))
+            (global-set-key key 'mouse-wheel-text-scale)
+            (push key mwheel-installed-text-scale-bindings))))
        ;; Bindings for scrolling.
        (t
         (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
-- 
2.20.1