bug#57140: New user option mouse-wheel-text-scale-buffer

[Tyler Grinn <tylergrinn@gmail.com>]

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

Tyler Grinn <tylergrinn@gmail.com> writes:

> 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

There was a typo.


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

From 94f0b6a2522050b8304aab0d85f3129805c1025e 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..16a63a8105 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 0
+  "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