From b41e6cfe91729c1f5a44be73b9dbe9a253c3d4a9 Mon Sep 17 00:00:00 2001
From: "patthoyts@users.sourceforge.net" <patthoyts>
Date: Wed, 13 Aug 2003 10:28:21 +0000
Subject: 	* library/scale.tcl: Fix for bug #787065 for Button-2 press. 
 * tests/scale.test: Added test for this bug.

---
 library/scale.tcl |  4 +++-
 tests/scale.test  | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 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
 
-- 
cgit v0.12