From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#38187: 27.0.50; No mouse-wheel scaling on images Date: Thu, 21 Nov 2019 01:12:17 +0200 Organization: LINKOV.NET Message-ID: <87h82ykur6.fsf@mail.linkov.net> References: <87tv79ksuz.fsf@mail.linkov.net> <83zhgy62u8.fsf@gnu.org> <87y2we7r90.fsf@gnus.org> <83lfse5w04.fsf@gnu.org> <87a78u7ags.fsf@gnus.org> <878soemc79.fsf@marxist.se> <87mucut8ch.fsf@mail.linkov.net> <87ftilsg6q.fsf@gnus.org> <87r224sw6s.fsf@mail.linkov.net> <87zhgsnv7x.fsf@gnus.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="228232"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (x86_64-pc-linux-gnu) Cc: Stefan Kangas , 38187@debbugs.gnu.org To: Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Nov 21 00:16:40 2019 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1iXZDE-000xH5-KT for geb-bug-gnu-emacs@m.gmane.org; Thu, 21 Nov 2019 00:16:40 +0100 Original-Received: from localhost ([::1]:34978 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iXZDD-0000lm-Cd for geb-bug-gnu-emacs@m.gmane.org; Wed, 20 Nov 2019 18:16:39 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:51221) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iXZCn-0000fi-R4 for bug-gnu-emacs@gnu.org; Wed, 20 Nov 2019 18:16:15 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iXZCm-0008P0-5P for bug-gnu-emacs@gnu.org; Wed, 20 Nov 2019 18:16:13 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:42253) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iXZCl-0008Ob-Sm for bug-gnu-emacs@gnu.org; Wed, 20 Nov 2019 18:16:12 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iXZCl-0006lD-IP for bug-gnu-emacs@gnu.org; Wed, 20 Nov 2019 18:16:11 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 20 Nov 2019 23:16:11 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38187 X-GNU-PR-Package: emacs Original-Received: via spool by 38187-submit@debbugs.gnu.org id=B38187.157429174425926 (code B ref 38187); Wed, 20 Nov 2019 23:16:11 +0000 Original-Received: (at 38187) by debbugs.gnu.org; 20 Nov 2019 23:15:44 +0000 Original-Received: from localhost ([127.0.0.1]:51072 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iXZCK-0006k6-18 for submit@debbugs.gnu.org; Wed, 20 Nov 2019 18:15:44 -0500 Original-Received: from camel.birch.relay.mailchannels.net ([23.83.209.29]:5601) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iXZCG-0006ju-2a for 38187@debbugs.gnu.org; Wed, 20 Nov 2019 18:15:40 -0500 X-Sender-Id: dreamhost|x-authsender|jurta@jurta.org Original-Received: from relay.mailchannels.net (localhost [127.0.0.1]) by relay.mailchannels.net (Postfix) with ESMTP id E76246A1764; Wed, 20 Nov 2019 23:15:38 +0000 (UTC) Original-Received: from pdx1-sub0-mail-a44.g.dreamhost.com (100-96-89-221.trex.outbound.svc.cluster.local [100.96.89.221]) (Authenticated sender: dreamhost) by relay.mailchannels.net (Postfix) with ESMTPA id 45C5C6A168C; Wed, 20 Nov 2019 23:15:38 +0000 (UTC) X-Sender-Id: dreamhost|x-authsender|jurta@jurta.org Original-Received: from pdx1-sub0-mail-a44.g.dreamhost.com ([TEMPUNAVAIL]. [64.90.62.162]) (using TLSv1.2 with cipher DHE-RSA-AES256-GCM-SHA384) by 0.0.0.0:2500 (trex/5.18.5); Wed, 20 Nov 2019 23:15:38 +0000 X-MC-Relay: Neutral X-MailChannels-SenderId: dreamhost|x-authsender|jurta@jurta.org X-MailChannels-Auth-Id: dreamhost X-Abaft-Name: 48fa539c4b8ebc51_1574291738544_3845582683 X-MC-Loop-Signature: 1574291738544:3753294061 X-MC-Ingress-Time: 1574291738544 Original-Received: from pdx1-sub0-mail-a44.g.dreamhost.com (localhost [127.0.0.1]) by pdx1-sub0-mail-a44.g.dreamhost.com (Postfix) with ESMTP id BA306832E1; Wed, 20 Nov 2019 15:15:35 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=linkov.net; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; s=linkov.net; bh=FmgIv+WYS2+lQlUYJshrFNDwqAY=; b= mgcRbRgW9yYZKyWhiFBMCPl9wpdEEV6XvJ5BSity4GN7SelhH3rO+nTVkA4DQFFn kBXnr9OOfgxTn1bweBIpllKCyMNUT1a6smV9vEkjkbR9SZCHDQWqkpuzyQOuLQPQ Guwm/2iHEUb0mxpI3KuCHUJ5j+xwHC/eL9nWheqERfU= Original-Received: from mail.jurta.org (m91-129-102-1.cust.tele2.ee [91.129.102.1]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) (Authenticated sender: jurta@jurta.org) by pdx1-sub0-mail-a44.g.dreamhost.com (Postfix) with ESMTPSA id 74FB1832DA; Wed, 20 Nov 2019 15:15:31 -0800 (PST) X-DH-BACKEND: pdx1-sub0-mail-a44 In-Reply-To: <87zhgsnv7x.fsf@gnus.org> (Lars Ingebrigtsen's message of "Tue, 19 Nov 2019 09:09:22 +0100") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:172084 Archived-At: --=-=-= Content-Type: text/plain >> 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: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=debounce-reduce.patch 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)))))))) + (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) --=-=-=--