* library/scale.tcl: Fix for bug #787065 for Button-2 press.

	* tests/scale.test: Added test for this bug.

1 files changed, 51 insertions, 1 deletions

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