bug#38187: 27.0.50; No mouse-wheel scaling on images

[Juri Linkov <juri@linkov.net>]

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

>> I tested this patch, and it works well:
>
> Great!  And I agree with Eli's comment -- a separate wrapper command
> that just takes an event would be a clearer interface.

I noticed that using the mouse-wheel on images is not responsive enough.
It takes too much time when every step of the mouse scrolling wheel
needs to scale the image separately for every consecutive rescaling.

So I experimented with debouncing - a new macro 'debounce' swallows
all intermediate calls in quick succession to 'image--change-size',
and executes only the last call in sequence.

But actually it requires another better macro 'debounce-reduce'
that accumulates the state from all calls by multiplying all
intermediate scaling factors, and using the result on the final call:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: debounce-reduce.patch --]
[-- Type: text/x-diff, Size: 4245 bytes --]

diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 561cc70078..48301fd4fd 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -488,6 +488,48 @@ y-or-n-p-with-timeout
 If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
   (with-timeout (seconds default-value)
     (y-or-n-p prompt)))
+
+(defmacro debounce (secs function)
+  "Call FUNCTION after SECS seconds have elapsed.
+Postpone FUNCTION call until after SECS seconds have elapsed since the
+last time it was invoked.  On consecutive calls within the interval of
+SECS seconds, cancel all previous calls and in quick succession execute
+only the last call."
+  (declare (indent 1) (debug t))
+  (let ((timer-sym (make-symbol "timer")))
+    `(let (,timer-sym)
+       (lambda (&rest args)
+         (when (timerp ,timer-sym)
+           (cancel-timer ,timer-sym))
+         (setq ,timer-sym
+               (run-with-timer
+                ,secs nil (lambda ()
+                            (apply ,function args))))))))
+
+(defmacro debounce-reduce (secs state-function function)
+  "Call FUNCTION after SECS seconds have elapsed.
+Postpone FUNCTION call until after SECS seconds have elapsed since the
+last time it was invoked.  On consecutive calls within the interval of
+SECS seconds, cancel all previous calls and in quick succession execute
+only the last call.
+STATE-FUNCTION can be used to calculate the state on consecutive calls,
+and execute the last call with the collected state."
+  (declare (indent 1) (debug t))
+  (let ((timer-sym (make-symbol "timer"))
+        (state-sym (make-symbol "state")))
+    `(let (,timer-sym ,state-sym)
+       (lambda (&rest args)
+         (setq ,state-sym (apply ,state-function ,state-sym args))
+         (when (timerp ,timer-sym)
+           (cancel-timer ,timer-sym))
+         (setq ,timer-sym
+               (run-with-timer
+                ,secs nil (lambda ()
+                            (apply ,function (if (listp ,state-sym)
+                                                 ,state-sym
+                                               (list ,state-sym)))
+                            (setq ,state-sym nil))))))))
+
 \f
 (defconst timer-duration-words
   (list (cons "microsec" 0.000001)
diff --git a/lisp/image.el b/lisp/image.el
index e0965c1091..d57ae3a720 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1016,18 +1016,20 @@ image-increase-size
 If N is 3, then the image size will be increased by 30%.  The
 default is 20%."
   (interactive "P")
-  (image--change-size (if n
-                          (1+ (/ (prefix-numeric-value n) 10.0))
-                        1.2)))
+  (funcall image--change-size
+           (if n
+               (1+ (/ (prefix-numeric-value n) 10.0))
+             1.2)))
 
 (defun image-decrease-size (&optional n)
   "Decrease the image size by a factor of N.
 If N is 3, then the image size will be decreased by 30%.  The
 default is 20%."
   (interactive "P")
-  (image--change-size (if n
-                          (- 1 (/ (prefix-numeric-value n) 10.0))
-                        0.8)))
+  (funcall image--change-size
+           (if n
+               (- 1 (/ (prefix-numeric-value n) 10.0))
+             0.8)))
 
 (defun image-mouse-increase-size (&optional event)
   "Increase the image size using the mouse."
@@ -1062,12 +1064,16 @@ image--get-imagemagick-and-warn
       (plist-put (cdr image) :type 'imagemagick))
     image))
 
-(defun image--change-size (factor)
-  (let* ((image (image--get-imagemagick-and-warn))
-         (new-image (image--image-without-parameters image))
-         (scale (image--current-scaling image new-image)))
-    (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+(defvar image--change-size
+  (debounce-reduce 0.3
+    (lambda (state factor)
+      (* (or state 1) factor))
+    (lambda (factor)
+      (let* ((image (image--get-imagemagick-and-warn))
+             (new-image (image--image-without-parameters image))
+             (scale (image--current-scaling image new-image)))
+        (setcdr image (cdr new-image))
+        (plist-put (cdr image) :scale (* scale factor))))))
 
 (defun image--image-without-parameters (image)
   (cons (pop image)