From c87f900d71d3fdbd7fe3703bd22c3e738e973dd9 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
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