1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-07 12:41:56 +00:00

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)
This commit is contained in:
Juri Linkov 2019-11-24 00:22:46 +02:00
parent 8934762bb3
commit 4b5d04be44
3 changed files with 67 additions and 12 deletions

View File

@ -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.
+++

View File

@ -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)

View File

@ -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)