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

From: Stefan Kangas <[email-masked]>
Date: Tue, 8 Oct 2019 23:58:09 +0200

Stefan Kangas <[email-masked]> writes:

> > What is expected is that mouse scrolling in the non-selected window
> > will affect the non-selected window.  Does this need to be changed?
>
> I'm not sure, but I think I agree with you that it should be changed.
> Perhaps we could try it and see if it feels better?

It turns out there is already a defcustom 'mouse-wheel-follows-mouse'
that controls this behaviour when scrolling.  If non-nil (the default)
it will scroll the window that the mouse pointer is over, otherwise
the one where point is.  So the job is not that hard: we should just
do what the user wants.

The attached patch makes changing font size respect that option.  What
do you think?

Best regards,
Stefan Kangas
From 9172e861f69b811fd0da5e8be4cd7c1cf3c66e6f Mon Sep 17 00:00:00 2001
From: Stefan Kangas <[email-masked]>
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'.
---
 lisp/mwheel.el | 77 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 47 insertions(+), 30 deletions(-)

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 9b67e71886..96cf286db1 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -210,34 +210,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 +328,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 +367,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 +376,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