New user option mouse-wheel-text-scale-buffer

[Tyler Grinn <tylergrinn@gmail.com>]

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


By default, mouse-wheel-(global-)text-scale increases or decreases the
text scale for every scroll event. I think it's a good idea to have an
option to buffer that (is that the right word?) so you can more easily
choose the text scale you want. I kept the default behavior intact.

Best,

Tyler


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mouse-wheel-text-scale-buffer --]
[-- Type: text/x-patch, Size: 3632 bytes --]

From 6f8b8dda65038bb66ede2097b8b7bc34b7f1130d Mon Sep 17 00:00:00 2001
From: Tyler Grinn <tylergrinn@gmail.com>
Date: Wed, 10 Aug 2022 22:32:12 -0400
Subject: [PATCH] Add new user option mouse-wheel-text-scale-buffer

* lisp/mwheel.el (mouse-wheel-text-scale-buffer): New user option.
(mouse-wheel-text-scale): Use it.
(mouse-wheel-global-text-scale): Use it.
---
 lisp/mwheel.el | 31 +++++++++++++++++++++++++++----
 1 file changed, 27 insertions(+), 4 deletions(-)

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index ba5255fc07..506eccaaed 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -214,6 +214,14 @@ mouse-wheel-flip-direction
   :type 'boolean
   :version "26.1")
 
+(defcustom mouse-wheel-text-scale-buffer 1
+  "Buffer this many mouse scroll events before changing text scale.
+By default, every scroll event will trigger one text scale adjustment.
+Increase this number to hinder text scale adjustments while scrolling."
+  :group 'mouse
+  :type 'number
+  :version "29.1")
+
 (defun mwheel-event-button (event)
   (let ((x (event-basic-type event)))
     ;; Map mouse-wheel events to appropriate buttons
@@ -424,6 +432,9 @@ mwheel-scroll
 
 (put 'mwheel-scroll 'scroll-command t)
 
+(defvar mouse-wheel-text-scale-counter 0
+  "Keeps track of how many mouse events since last text-scale.")
+
 (defun mouse-wheel-text-scale (event)
   "Adjust font size of the default face according to EVENT.
 See also `text-scale-adjust'."
@@ -435,10 +446,16 @@ mouse-wheel-text-scale
     (unwind-protect
         (cond ((memq button (list mouse-wheel-down-event
                                   mouse-wheel-down-alternate-event))
-               (text-scale-increase 1))
+               (setq mouse-wheel-text-scale-counter (1- mouse-wheel-text-scale-counter))
+               (when (<= mouse-wheel-text-scale-counter (- mouse-wheel-text-scale-buffer))
+                 (setq mouse-wheel-text-scale-counter 0)
+                 (text-scale-increase 1)))
               ((memq button (list mouse-wheel-up-event
                                   mouse-wheel-up-alternate-event))
-               (text-scale-decrease 1)))
+               (setq mouse-wheel-text-scale-counter (1+ mouse-wheel-text-scale-counter))
+               (when (>= mouse-wheel-text-scale-counter mouse-wheel-text-scale-buffer)
+                 (setq mouse-wheel-text-scale-counter 0)
+                 (text-scale-decrease 1))))
       (select-window selected-window))))
 
 (declare-function global-text-scale-adjust "face-remap.el" (increment))
@@ -450,10 +467,16 @@ mouse-wheel-global-text-scale
     (unwind-protect
         (cond ((memq button (list mouse-wheel-down-event
                                   mouse-wheel-down-alternate-event))
-               (global-text-scale-adjust 1))
+               (setq mouse-wheel-text-scale-counter (1- mouse-wheel-text-scale-counter))
+               (when (<= mouse-wheel-text-scale-counter (- mouse-wheel-text-scale-buffer))
+                 (setq mouse-wheel-text-scale-counter 0)
+                 (global-text-scale-adjust 1)))
               ((memq button (list mouse-wheel-up-event
                                   mouse-wheel-up-alternate-event))
-               (global-text-scale-adjust -1))))))
+               (setq mouse-wheel-text-scale-counter (1+ mouse-wheel-text-scale-counter))
+               (when (>= mouse-wheel-text-scale-counter mouse-wheel-text-scale-buffer)
+                 (setq mouse-wheel-text-scale-counter 0)
+                 (global-text-scale-adjust -1)))))))
 
 (defun mouse-wheel--add-binding (key fun)
   "Bind mouse wheel button KEY to function FUN.
-- 
2.37.1