summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorfvogel <fvogelnew1@free.fr>2016-03-07 21:01:49 (GMT)
committerfvogel <fvogelnew1@free.fr>2016-03-07 21:01:49 (GMT)
commit1e12a7a6bfefbc1315f92dfb45a245d831328e4e (patch)
tree40b9d6f440e7ddb575b8a3c05012c6251aad6489
parentc7d53262ae761b4bffa6be4626431ec3e58bf394 (diff)
downloadtk-1e12a7a6bfefbc1315f92dfb45a245d831328e4e.zip
tk-1e12a7a6bfefbc1315f92dfb45a245d831328e4e.tar.gz
tk-1e12a7a6bfefbc1315f92dfb45a245d831328e4e.tar.bz2
Fixed bug [2262543] - Scale widget unexpectedly fires command callback (cherrypicked [3c1a8559dd])
-rw-r--r--generic/tkScale.c15
-rw-r--r--tests/scale.test108
2 files changed, 122 insertions, 1 deletions
diff --git a/generic/tkScale.c b/generic/tkScale.c
index cc7c294..cbc5202 100644
--- a/generic/tkScale.c
+++ b/generic/tkScale.c
@@ -303,6 +303,12 @@ Tk_ScaleObjCmd(
return TCL_ERROR;
}
+ /*
+ * The widget was just created, no command callback must be invoked.
+ */
+
+ scalePtr->flags &= ~INVOKE_COMMAND;
+
Tcl_SetObjResult(interp, TkNewWindowObj(scalePtr->tkwin));
return TCL_OK;
}
@@ -1268,7 +1274,14 @@ TkScaleSetValue(
return;
}
scalePtr->value = value;
- if (invokeCommand) {
+
+ /*
+ * Schedule command callback invocation only if there is such a command
+ * already registered, otherwise the callback would trigger later when
+ * configuring the widget -command option even if the value did not change.
+ */
+
+ if ((invokeCommand) && (scalePtr->command != NULL)) {
scalePtr->flags |= INVOKE_COMMAND;
}
TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
diff --git a/tests/scale.test b/tests/scale.test
index a8d08a8..8c14ed4 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -1396,6 +1396,114 @@ test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \
} \
-result {1.0 1.0 1.0 1.0}
+test scale-20.1 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 1} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+} -body {
+ scale .s -from 1 -to 50 -command {set commandedVar}
+ pack .s
+ update ; # -command callback shall NOT fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {1 -1}
+test scale-20.2 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 2} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+ set scaleVar 7
+} -body {
+ scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar}
+ pack .s
+ update ; # -command callback shall NOT fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {7 -1}
+test scale-20.3 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 3} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+} -body {
+ scale .s -from 1 -to 50
+ .s set 10
+ .s configure -command {set commandedVar}
+ pack .s
+ update ; # -command callback shall NOT fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {10 -1}
+test scale-20.4 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 4} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+} -body {
+ scale .s -from 1 -to 50 -command {set commandedVar}
+ .s set 10
+ pack .s
+ update ; # -command callback shall fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {10 10}
+test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 5} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+} -body {
+ scale .s -from 1 -to 50
+ pack .s
+ .s set 10
+ .s configure -command {set commandedVar}
+ update ; # -command callback shall NOT fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {10 -1}
+test scale-20.6 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 6} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+} -body {
+ scale .s -from 1 -to 50
+ pack .s
+ .s configure -command {set commandedVar}
+ .s set 10
+ update ; # -command callback shall fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {10 10}
+test scale-20.7 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 7} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+} -body {
+ scale .s -from 1 -to 50 -command {set commandedVar}
+ pack .s
+ .s set 10
+ update ; # -command callback shall fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {10 10}
+test scale-20.8 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 8} -setup {
+ catch {destroy .s}
+ set res {}
+ set commandedVar -1
+ set scaleVar 7
+} -body {
+ scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar}
+ pack .s
+ .s set 10
+ update ; # -command callback shall fire
+ set res [list [.s get] $commandedVar]
+} -cleanup {
+ destroy .s
+} -result {10 10}
+
option clear
# cleanup