summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2003-08-13 10:28:21 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2003-08-13 10:28:21 (GMT)
commit83c5ef89d9d718ed6d0d73b462e5e151c34533ef (patch)
tree1ce7efd2a5eb0c65d8061dbd5f2ff9bc801e63d4
parentb0f648ca07ee75943d80ed107f90e99616870a35 (diff)
downloadtk-83c5ef89d9d718ed6d0d73b462e5e151c34533ef.zip
tk-83c5ef89d9d718ed6d0d73b462e5e151c34533ef.tar.gz
tk-83c5ef89d9d718ed6d0d73b462e5e151c34533ef.tar.bz2
* library/scale.tcl: Fix for bug #787065 for Button-2 press.
* tests/scale.test: Added test for this bug.
-rw-r--r--library/scale.tcl4
-rw-r--r--tests/scale.test52
2 files changed, 54 insertions, 2 deletions
diff --git a/library/scale.tcl b/library/scale.tcl
index e06bcf8..c704601 100644
--- a/library/scale.tcl
+++ b/library/scale.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
-# RCS: @(#) $Id: scale.tcl,v 1.10 2003/07/19 01:20:17 patthoyts Exp $
+# RCS: @(#) $Id: scale.tcl,v 1.11 2003/08/13 10:28:21 patthoyts Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -272,10 +272,12 @@ proc ::tk::ScaleButton2Down {w x y} {
if {[string equal [$w cget -state] "disabled"]} {
return
}
+
$w configure -state active
$w set [$w get $x $y]
set Priv(dragging) 1
set Priv(initValue) [$w get]
+ set Priv($w,relief) [$w cget -sliderrelief]
set coords "$x $y"
set Priv(deltaX) 0
set Priv(deltaY) 0
diff --git a/tests/scale.test b/tests/scale.test
index ae2803e..13c1d3a 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: scale.test,v 1.13 2003/04/01 21:06:50 dgp Exp $
+# RCS: @(#) $Id: scale.test,v 1.14 2003/08/13 10:28:21 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -814,6 +814,56 @@ test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
destroy .s
} {}
+test scale-18.2 {Scale button 1 events [Bug 787065]} \
+ -setup {
+ catch {destroy .s}
+ set y 5
+ scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
+ pack .s
+ tkwait visibility .s
+ set ::error {}
+ proc bgerror {args} {set ::error $args}
+ } \
+ -body {
+ list [catch {
+ event generate .s <1> -x 0 -y 0
+ event generate .s <ButtonRelease-1> -x 0 -y 0
+ update
+ set ::error
+ } msg] $msg
+ } \
+ -cleanup {
+ unset ::error
+ rename bgerror {}
+ catch {destroy .s}
+ } \
+ -result {0 {}}
+
+test scale-18.3 {Scale button 2 events [Bug 787065]} \
+ -setup {
+ catch {destroy .s}
+ set y 5
+ scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
+ pack .s
+ tkwait visibility .s
+ set ::error {}
+ proc bgerror {args} {set ::error $args}
+ } \
+ -body {
+ list [catch {
+ event generate .s <2> -x 0 -y 0
+ event generate .s <ButtonRelease-2> -x 0 -y 0
+ update
+ set ::error
+ } msg] $msg
+ } \
+ -cleanup {
+ unset ::error
+ rename bgerror {}
+ catch {destroy .s}
+ } \
+ -result {0 {}}
+
catch {destroy .s}
option clear