From 02b366958959bb15d580560b7360297c330b26f7 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 25 Feb 2022 23:13:05 +0000 Subject: Fix [415415fff]: Long callback: One click -> Two steps. --- library/scale.tcl | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/library/scale.tcl b/library/scale.tcl index fb9b81b..acd6d75 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -210,7 +210,20 @@ proc ::tk::ScaleEndDrag {w} { proc ::tk::ScaleIncrement {w dir big repeat} { variable ::tk::Priv + if {![winfo exists $w]} return + + # give the cancel callback a chance to fire if the execution time of + # the -command script lasts longer than -repeatdelay + set clockms [clock milliseconds] + if {$repeat eq "again" && + [expr {$clockms - $Priv(clockms)}] > [expr {[$w cget -repeatinterval] * 1.1}]} { + set Priv(clockms) $clockms + set Priv(afterId) [after [$w cget -repeatinterval] \ + [list tk::ScaleIncrement $w $dir $big again]] + return + } + if {$big eq "big"} { set inc [$w cget -bigincrement] if {$inc == 0} { @@ -231,14 +244,18 @@ proc ::tk::ScaleIncrement {w dir big repeat} { set inc [expr {-$inc}] } } + # this will run the -command script (if any) during the redrawing + # of the scale at idle time $w set [expr {[$w get] + $inc}] if {$repeat eq "again"} { + set Priv(clockms) $clockms set Priv(afterId) [after [$w cget -repeatinterval] \ [list tk::ScaleIncrement $w $dir $big again]] } elseif {$repeat eq "initial"} { set delay [$w cget -repeatdelay] if {$delay > 0} { + set Priv(clockms) $clockms set Priv(afterId) [after $delay \ [list tk::ScaleIncrement $w $dir $big again]] } -- cgit v0.12 From 15fe190c755cab700c23b1bdc1940b41e33f122d Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 28 Feb 2022 20:49:35 +0000 Subject: More accurate comment. --- library/scale.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/scale.tcl b/library/scale.tcl index acd6d75..466a3ce 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -213,7 +213,7 @@ proc ::tk::ScaleIncrement {w dir big repeat} { if {![winfo exists $w]} return - # give the cancel callback a chance to fire if the execution time of + # give the cancel callback a chance to be serviced if the execution time of # the -command script lasts longer than -repeatdelay set clockms [clock milliseconds] if {$repeat eq "again" && -- cgit v0.12 From a9282615584405177536ca546f482f537a2839ad Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 14 Mar 2022 22:03:57 +0000 Subject: Add non-regression test scale-18.3, failing before the fix, and passing after the fix. --- tests/scale.test | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/tests/scale.test b/tests/scale.test index 6e62710..856a7bf 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -1395,7 +1395,25 @@ test scale-18.3 {Scale button 2 events [Bug 787065]} -setup { rename bgerror {} destroy .s } -result {0 {}} - +test scale-18.3 {Bug [415415ffff] - Long callback: One click -> Several steps} -setup { + catch {destroy .s} + scale .s -from 0 -to 5 -resolution 1 -variable x1 -orient horizontal -length 100\ + -command longCmd -repeatdelay 300 + pack .s + update + proc longCmd {unused} { + after 500 + } +} -body { + foreach {x y} [.s coord 50] {} + event generate .s -x $x -y $y + update + event generate .s -x $x -y $y + update + set x1 +} -cleanup { + destroy .s +} -result {1} test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \ -setup { -- cgit v0.12 From febc03541b2ba778fd3156341c1b292821486407 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 15 Mar 2022 21:15:11 +0000 Subject: Try a slightly different test scale-18.3 since it failed for all platforms at Github Actions (while it passes locally on my Win 10). --- tests/scale.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/scale.test b/tests/scale.test index 856a7bf..a2f4eca 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -1407,9 +1407,9 @@ test scale-18.3 {Bug [415415ffff] - Long callback: One click -> Several steps} - } -body { foreach {x y} [.s coord 50] {} event generate .s -x $x -y $y - update + after 50 event generate .s -x $x -y $y - update + after 50 ; update set x1 } -cleanup { destroy .s -- cgit v0.12 From d1b32da5067a637798b6ccc72d451f4e665a8995 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 19 Mar 2022 16:02:35 +0000 Subject: Revert previous commit since it does not let the tests pass at Github. Moreover, change the test name to scale-18.4, which was unused so far (contrary to scale-18.3). --- tests/scale.test | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/scale.test b/tests/scale.test index a2f4eca..67b3261 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -1395,7 +1395,8 @@ test scale-18.3 {Scale button 2 events [Bug 787065]} -setup { rename bgerror {} destroy .s } -result {0 {}} -test scale-18.3 {Bug [415415ffff] - Long callback: One click -> Several steps} -setup { + +test scale-18.4 {Bug [415415ffff] - Long callback: One click -> Several steps} -setup { catch {destroy .s} scale .s -from 0 -to 5 -resolution 1 -variable x1 -orient horizontal -length 100\ -command longCmd -repeatdelay 300 @@ -1407,9 +1408,9 @@ test scale-18.3 {Bug [415415ffff] - Long callback: One click -> Several steps} - } -body { foreach {x y} [.s coord 50] {} event generate .s -x $x -y $y - after 50 + update event generate .s -x $x -y $y - after 50 ; update + update set x1 } -cleanup { destroy .s -- cgit v0.12 From 96818aab884e29a5810c89e38e1679ffe4868ff5 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 19 Mar 2022 22:55:06 +0000 Subject: Add a comment pinpointing the specific case purpose of the test. --- tests/scale.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/scale.test b/tests/scale.test index 67b3261..157f1fe 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -1398,12 +1398,12 @@ test scale-18.3 {Scale button 2 events [Bug 787065]} -setup { test scale-18.4 {Bug [415415ffff] - Long callback: One click -> Several steps} -setup { catch {destroy .s} - scale .s -from 0 -to 5 -resolution 1 -variable x1 -orient horizontal -length 100\ + scale .s -from 0 -to 5 -resolution 1 -variable x1 -orient horizontal -length 100 \ -command longCmd -repeatdelay 300 pack .s update proc longCmd {unused} { - after 500 + after 500 ; # larger than -repeatdelay } } -body { foreach {x y} [.s coord 50] {} -- cgit v0.12 From ad2bdd9029fd93c161662e44725167d613ea961e Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 28 Mar 2022 20:24:41 +0000 Subject: Unsetting variable at the end of tests using them avoids unwanted test interactions (here: between event-7.1 (or event-7.2) and scale-18.4. --- tests/event.test | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/event.test b/tests/event.test index c521b25..3f5012a 100644 --- a/tests/event.test +++ b/tests/event.test @@ -756,6 +756,7 @@ test event-7.1(double-click) {A double click on a lone character return $result } -cleanup { deleteWindows + unset x1 y1 width height middle_y left_x left_y right_x right_y } -result {1.3 A 1.3 A} test event-7.2(double-click) {A double click on a lone character in an entry widget should select that character} -setup { @@ -822,6 +823,7 @@ test event-7.2(double-click) {A double click on a lone character return $result } -cleanup { deleteWindows + unset x1 y1 width height middle_y left_x left_y right_x right_y } -result {4 A 4 A} test event-8 {event generate with keysyms corresponding to -- cgit v0.12