Use new macro debounce-reduce to make mouse scaling of images more responsive

* lisp/emacs-lisp/timer.el (debounce, debounce-reduce): New macros.

* lisp/image.el (image-increase-size, image-decrease-size):
Use funcall to call image--change-size-function.
(image--change-size-function): Move code from defun of
image--change-size to defvar that has the value of lambda
returned from debounce-reduce.  (Bug#38187)

diff --git a/etc/NEWS b/etc/NEWS
index 3bf4c81014b040c2893bc8138f83fc52d5110ca0..819637b79fca544ac6500a4e634af0738c6f4123 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2796,6 +2796,11 @@ doing computations on a decoded time structure), 'make-decoded-time'
 filled out), and 'encoded-time-set-defaults' (which fills in nil
 elements as if it's midnight January 1st, 1970) have been added.
 
+** New macros 'debounce' and 'debounce-reduce' postpone function call
+until after specified time have elapsed since the last time it was invoked.
+This improves performance of processing events occurring rapidly
+in quick succession.
+
 ** 'define-minor-mode' automatically documents the meaning of ARG.
 
 +++

diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 561cc70078f5b41ef607c8c988127129041e49c0..5fdf9a426a75eeb4824c9d3b5f1f9df01ceb477d 100644 (file)
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -488,6 +488,50 @@ The argument should be a value previously returned by `with-timeout-suspend'."
 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 that occur rapidly in quick succession,
+and execute only the last call.  This improves performance of event processing."
+  (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 initial-state 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 that occur rapidly in quick succession,
+and execute only the last call.  This improves performance of event processing.
+
+STATE-FUNCTION can be used to accumulate the state on consecutive calls
+starting with the value of INITIAL-STATE, and then execute the last call
+with the collected state value."
+  (declare (indent 1) (debug t))
+  (let ((timer-sym (make-symbol "timer"))
+        (state-sym (make-symbol "state")))
+    `(let (,timer-sym (,state-sym ,initial-state))
+       (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 ,initial-state))))))))
+
 \f
 (defconst timer-duration-words
   (list (cons "microsec" 0.000001)

diff --git a/lisp/image.el b/lisp/image.el
index 6e19f17fd25f5e173ae30e2e3953466cdf7b4af0..c430478232777657aa1c331b5a0200ce9e61d270 100644 (file)
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1017,18 +1017,20 @@ has no effect."
 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-function
+           (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-function
+           (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."
@@ -1063,12 +1065,16 @@ default is 20%."
       (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-function
+  (debounce-reduce 0.3 1
+    (lambda (state factor)
+      (* state 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)