Commit 4b5d04be authored by Juri Linkov's avatar Juri Linkov

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)
parent 8934762b
Pipeline #4148 failed with stage
in 63 minutes and 59 seconds
......@@ -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.
+++
......
......@@ -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))))))))
(defconst timer-duration-words
(list (cons "microsec" 0.000001)
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment