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

From: Stefan Kangas <[email-masked]>
Date: Wed, 21 Aug 2019 15:19:08 +0200

Drew Adams <[email-masked]> writes:

> > I think this is a good idea, which has the usability benefit to mirror
> > what happens in many common browsers, and other common text editors.
> > I remember myself that I was struggling to find the binding to change
> > the font size when I was an Emacs beginner.
> >
> > I have implemented this suggestion in the attached patch.
> >
> > However, this will be an incompatible change, since this was
> > previously bound to scrolling up and down by close to a full screen.
> > I therefore moved that binding to the meta modifier and wrote a NEWS
> > item that explains how to get the old functionality back.
> >
> > How does it look?
>
> I'm not sure that mouse-4 and mouse-5 have that meaning
> for all mice and platforms.  Some mice have separate
> mouse-4 and mouse-5 buttons.

Thanks.  Your comment made me realize that my entire approach had been
a bit naive.  I've now reworked the patch to only enable these key
bindings when mouse-wheel-mode is enabled, and added a defcustom to
change which modifier the font size functionality will use (or to
optionally disable it completely).

One small comment regarding the patch.  We could perhaps get away with
not adding the defvar mwheel-installed-text-scale-bindings, but I
added that to make sure that we don't accidentally remove any key
bindings we didn't mean to.  I might be too defensive here, though, so
please let me know if simpler code is preferred here over this level
of cautiousness.

Thanks,
Stefan Kangas
From c87f900d71d3fdbd7fe3703bd22c3e738e973dd9 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <[email-masked]>
Date: Wed, 21 Aug 2019 03:38:49 +0200
Subject: [PATCH] Bind changing font size to mouse wheel up and down

* lisp/mouse.el (mouse-wheel-down-event, mouse-wheel-up-event): Bind
to text-scale-increase and text-scale-decrease.  (Bug#28182)
* lisp/mwheel.el (mouse-wheel-scroll-amount): Use the meta modifier
for scrolling by near full screen instead of control.
* etc/NEWS: Announce it.
---
 etc/NEWS       | 14 ++++++++++++++
 lisp/mwheel.el | 49 ++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 56 insertions(+), 7 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 3fdc185af4..3cdf7b2866 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2026,6 +2026,20 @@ valid event type.
 ---
 ** The obsolete package xesam.el (since Emacs 24) has been removed.
 
+---
+** Mouse scroll up and down with control key modifier changes font size.
+Previously, the control key modifier was used to scroll up or down by
+an amount which was close to near a full screen.  This functionality
+is now instead available by scrolling with the meta modifier key.
+
+You can get the old functionality back by customizing the variables
+'mouse-wheel-font-size-modifier-key' and 'mouse-wheel-scroll-amount',
+or adding the following to your Emacs init file:
+
+(customize-set-variable 'mouse-wheel-font-size-modifier-key nil)
+(customize-set-variable 'mouse-wheel-scroll-amount
+                        '(5 ((shift) . 1) ((control) . nil)))
+
 
 * Lisp Changes in Emacs 27.1
 
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index dfea55374b..2eb67be916 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -84,7 +84,7 @@ mouse-wheel-inhibit-click-time
   :group 'mouse
   :type 'number)
 
-(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
+(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((meta) . nil))
   "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.
@@ -120,6 +120,17 @@ mouse-wheel-scroll-amount
                     (float :tag "Fraction of window")))))
   :set 'mouse-wheel-change-button)
 
+(defcustom mouse-wheel-font-size-modifier-key 'control
+  "Modifier key to use for changing font size using mouse wheel.
+If nil, do not set up bindings for changing the font size."
+  :group 'mouse
+  :type '(choice :tag "modifier"
+                 (const alt) (const control) (const hyper)
+                 (const meta) (const shift) (const super)
+                 (const nil))
+  :set 'mouse-wheel-change-button
+  :version "27.1")
+
 (defcustom mouse-wheel-progressive-speed t
   "If non-nil, the faster the user moves the wheel, the faster the scrolling.
 Note that this has no effect when `mouse-wheel-scroll-amount' specifies
@@ -306,6 +317,15 @@ mwheel-scroll
 (put 'mwheel-scroll 'scroll-command t)
 
 (defvar mwheel-installed-bindings nil)
+(defvar mwheel-installed-text-scale-bindings nil)
+
+(defun mouse-wheel--remove-bindings (bindings funs)
+  "Remove key BINDINGS if they're bound to any function in FUNS.
+BINDINGS is a list of key bindings, FUNS is a list of functions.
+This is a helper function for `mouse-wheel-mode'."
+  (dolist (key bindings)
+    (when (memq (lookup-key (current-global-map) key) funs)
+      (global-unset-key key))))
 
 (define-minor-mode mouse-wheel-mode
   "Toggle mouse wheel support (Mouse Wheel mode)."
@@ -318,17 +338,32 @@ mouse-wheel-mode
   :global t
   :group 'mouse
   ;; Remove previous bindings, if any.
-  (while mwheel-installed-bindings
-    (let ((key (pop mwheel-installed-bindings)))
-      (when (eq (lookup-key (current-global-map) key) 'mwheel-scroll)
-        (global-unset-key key))))
+  (mouse-wheel--remove-bindings mwheel-installed-bindings
+                               '(mwheel-scroll))
+  (mouse-wheel--remove-bindings mwheel-installed-text-scale-bindings
+                               '(text-scale-increase
+                                 text-scale-decrease))
+  (setq mwheel-installed-bindings nil)
+  (setq mwheel-installed-text-scale-bindings nil)
   ;; Setup bindings as needed.
   (when mouse-wheel-mode
-    (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-right-event mouse-wheel-left-event))
+    ;; Bindings for scrolling.
+    (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+                         mouse-wheel-right-event mouse-wheel-left-event))
       (dolist (key (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,event)])
                            mouse-wheel-scroll-amount))
         (global-set-key key 'mwheel-scroll)
-        (push key mwheel-installed-bindings)))))
+        (push key mwheel-installed-bindings)))
+    ;; Bindings for changing font size.
+    (when mouse-wheel-font-size-modifier-key
+      (let ((increase-key `[,(list mouse-wheel-font-size-modifier-key
+                                   mouse-wheel-down-event)])
+            (decrease-key `[,(list mouse-wheel-font-size-modifier-key
+                                   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)))))
 
 ;;; Compatibility entry point
 ;; preloaded ;;;###autoload
-- 
2.20.1