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

[Stefan Kangas <stefan@marxist.se>]

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

Juri Linkov <juri@linkov.net> writes:

> >> Another variant is to add special symbols to
> >> the existing customization, e.g.:
> >>
> >>   '(5 ((shift) . 1) ((control) . text-scale) ((meta) . nil))
> >>
> >> or even support text-scale step number if needed:
> >>
> >>   '(5 ((shift) . 1) ((control) . (text-scale . 1)) ((meta) . nil))
> >
> > I like your idea that this would all be defined in one place.
> >
> > One nit is that the variable name there is mouse-wheel-scroll-amount,
> > and I'm not sure this is the best name for functionality to change the
> > font size.  If we go ahead with that, perhaps it should be renamed to
> > something like mouse-wheel-scroll-modifiers?
>
> It looks like mouse-wheel-scroll-amount still makes some sense
> as using wheel-scrolling to change the amount of font pixels.
> Generally it's better to refrain from renaming old customisable
> variables when possible.

I've attached a tentative patch along those lines.  WDYT?

I'm not sure exactly how to reformulate the doc string for
mouse-wheel-scroll-amount to fit the new behaviour.  I'll have to
think about it a bit more.  Do let me know if you have any ideas.

Best regards,
Stefan Kangas

[-- Attachment #2: 0001-Support-changing-font-size-using-mouse-wheel.patch --]
[-- Type: text/x-patch, Size: 8021 bytes --]

From 974f0b8492684af35db21b1d8efe35dc94b0d491 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Wed, 21 Aug 2019 03:38:49 +0200
Subject: [PATCH] Support changing font size using mouse wheel

* lisp/mwheel.el (mouse-wheel-mode): Support changing font size (text
scaling) using mouse wheel.  (Bug#28182)
(mouse-wheel-scroll-amount): Bind the Ctrl modifier to text scaling.
(mwheel-installed-text-scale-bindings): New variable.
(mouse-wheel--remove-bindings): New helper function for
'mouse-wheel-mode'.

* doc/emacs/frames.texi (Mouse Commands): Document this feature.
* etc/NEWS: Announce it.
---
 doc/emacs/frames.texi | 10 +++---
 etc/NEWS              | 12 ++++++++
 lisp/mwheel.el        | 72 ++++++++++++++++++++++++++++++-------------
 3 files changed, 69 insertions(+), 25 deletions(-)

diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 367ac43a0a..1f4aa95c87 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -200,10 +200,12 @@ Mouse Commands
 @vindex mouse-wheel-progressive-speed
   Some mice have a ``wheel'' which can be used for scrolling.  Emacs
 supports scrolling windows with the mouse wheel, by default, on most
-graphical displays.  To toggle this feature, use @kbd{M-x
-mouse-wheel-mode}.  The variables @code{mouse-wheel-follow-mouse} and
-@code{mouse-wheel-scroll-amount} determine where and by how much
-buffers are scrolled.  The variable
+graphical displays.  There is also support for increasing or
+decreasing the height of the default face, by default bound to
+scrolling with the @key{Ctrl} modifier.  To toggle this feature, use
+@kbd{M-x mouse-wheel-mode}.  The variables
+@code{mouse-wheel-follow-mouse} and @code{mouse-wheel-scroll-amount}
+determine where and by how much buffers are scrolled.  The variable
 @code{mouse-wheel-progressive-speed} determines whether the scroll
 speed is linked to how fast you move the wheel.
 
diff --git a/etc/NEWS b/etc/NEWS
index 3fdc185af4..6831167c4d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2026,6 +2026,18 @@ 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 is now instead
+available by scrolling with the meta modifier key.
+
+To get the old behaviour back, customize the variable
+'mouse-wheel-scroll-amount', or add the following to your init file:
+
+(customize-set-variable 'mouse-wheel-scroll-amount
+                        '(5 ((shift) . 1) ((control) . nil)))
+
 \f
 * Lisp Changes in Emacs 27.1
 
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index dfea55374b..6e469ca698 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -84,17 +84,22 @@ 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) ((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.
-Elements of the list have the form (MODIFIERS . AMOUNT) or just AMOUNT if
-MODIFIERS is nil.
+Elements of the list have the form (MODIFIER . AMOUNT) or just AMOUNT if
+MODIFIER is nil.
 
 AMOUNT should be the number of lines to scroll, or nil for near full
 screen.  It can also be a floating point number, specifying the fraction of
 a full screen to scroll.  A near full screen is `next-screen-context-lines'
-less than a full screen."
+less than a full screen.
+
+If AMOUNT is the symbol text-scale, this means that with
+MODIFIER, the mouse wheel will change the face height instead of
+scrolling."
   :group 'mouse
   :type '(cons
 	  (choice :tag "Normal"
@@ -105,19 +110,20 @@ mouse-wheel-scroll-amount
 		   (repeat (choice :tag "modifier"
 				   (const alt) (const control) (const hyper)
 				   (const meta) (const shift) (const super)))
-		   (choice :tag "scroll amount"
-			   (const :tag "Full screen" :value nil)
-			   (integer :tag "Specific # of lines")
-			   (float :tag "Fraction of window"))))
+		   (choice :tag "action"
+			   (const :tag "Scroll full screen" :value nil)
+			   (integer :tag "Scroll specific # of lines")
+			   (float :tag "Scroll fraction of window"))))
           (repeat
            (cons
             (repeat (choice :tag "modifier"
 			    (const alt) (const control) (const hyper)
                             (const meta) (const shift) (const super)))
-            (choice :tag "scroll amount"
-                    (const :tag "Full screen" :value nil)
-                    (integer :tag "Specific # of lines")
-                    (float :tag "Fraction of window")))))
+            (choice :tag "action"
+                    (const :tag "Scroll full screen" :value nil)
+                    (integer :tag "Scroll specific # of lines")
+                    (float :tag "Scroll fraction of window")
+                    (const :tag "Change face size" :value text-scale)))))
   :set 'mouse-wheel-change-button)
 
 (defcustom mouse-wheel-progressive-speed t
@@ -306,6 +312,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 +333,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))
-      (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)))))
+    (dolist (binding mouse-wheel-scroll-amount)
+      (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)))
+       ;; Bindings for scrolling.
+       (t
+        (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+                             mouse-wheel-right-event mouse-wheel-left-event))
+          (let ((key `[(,@(if (consp binding) (car binding)) ,event)]))
+            (global-set-key key 'mwheel-scroll)
+            (push key mwheel-installed-bindings))))))))
 
 ;;; Compatibility entry point
 ;; preloaded ;;;###autoload
-- 
2.20.1