Fix MouseWheel bindings for ttk::treeview widget

(Fixes #1442006, #1821939, #1862692)


FossilOrigin-Name: 316f0f8777147fc815639503d83a512d48a3fba7

1 files changed, 79 insertions, 82 deletions

diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test
index 2fdce0c..d2b33a9 100644
--- a/tests/ttk/treeview.test
+++ b/tests/ttk/treeview.test
@@ -1,5 +1,5 @@
 #
-# $Id: treeview.test,v 1.2 2007/05/16 15:44:08 dgp Exp $
+# $Id: treeview.test,v 1.3 2008/01/06 19:16:12 jenglish Exp $
 #
 # [7Jun2005] TO CHECK: [$tv see {}] -- shouldn't work (at least, shouldn't do
 # what it currently does)
@@ -9,8 +9,6 @@ package require Tk 8.5
 package require tcltest ; namespace import -force tcltest::*
 loadTestedCommands
 
-testConstraint treeview [llength [info commands ttk::treeview]]
-
 # consistencyCheck --
 #	Traverse the tree to make sure the item data structures
 #	are properly linked.
@@ -19,7 +17,6 @@ testConstraint treeview [llength [info commands ttk::treeview]]
 #	follows ->prev links, this should cover all invariants.
 #
 proc consistencyCheck {tv {item {}}} {
-    if {![llength [info commands ttk::treeview]]} { return }
     set i 0;
     foreach child [$tv children $item] {
 	assert {[$tv parent $child] == $item} "parent $child = $item"
@@ -37,60 +34,60 @@ proc assert {expr {message ""}} {
     }
 }
 
-test treeview-0 "treeview test - setup" -constraints treeview -body {
+test treeview-0 "treeview test - setup" -body {
     ttk::treeview .tv -columns {a b c}
     pack .tv -expand true -fill both
     update
 }
 
-test treeview-1.1 "columns" -constraints treeview -body {
+test treeview-1.1 "columns" -body {
     .tv configure -columns {a b c}
 }
 
-test treeview-1.2 "Bad columns" -constraints treeview -body {
+test treeview-1.2 "Bad columns" -body {
     #.tv configure -columns {illegal "list"value}
     ttk::treeview .badtv -columns {illegal "list"value}
 } -returnCodes 1 -result "list element in quotes followed by*" -match glob
 
-test treeview-1.3 "bad displaycolumns" -constraints treeview -body {
+test treeview-1.3 "bad displaycolumns" -body {
     .tv configure -displaycolumns {a b d}
 } -returnCodes 1 -result "Invalid column index d"
 
-test treeview-1.4 "more bad displaycolumns" -constraints treeview -body {
+test treeview-1.4 "more bad displaycolumns" -body {
     .tv configure -displaycolumns {1 2 3}
 } -returnCodes 1 -result "Column index 3 out of bounds"
 
-test treeview-1.5 "Don't forget to check negative numbers" -constraints treeview -body {
+test treeview-1.5 "Don't forget to check negative numbers" -body {
     .tv configure -displaycolumns {1 -2 3}
 } -returnCodes 1 -result "Column index -2 out of bounds"
 
 # Item creation.
 #
-test treeview-2.1 "insert -- not enough args" -constraints treeview -body {
+test treeview-2.1 "insert -- not enough args" -body {
     .tv insert
 } -returnCodes 1 -result "wrong # args: *" -match glob
 
-test treeview-2.3 "insert -- bad integer index" -constraints treeview -body {
+test treeview-2.3 "insert -- bad integer index" -body {
     .tv insert {} badindex
 } -returnCodes 1 -result "expected integer *" -match glob
 
-test treeview-2.4 "insert -- bad parent node" -constraints treeview -body {
+test treeview-2.4 "insert -- bad parent node" -body {
     .tv insert badparent end
 } -returnCodes 1 -result "Item badparent not found" -match glob
 
-test treeview-2.5 "insert -- finaly insert a node" -constraints treeview -body {
+test treeview-2.5 "insert -- finaly insert a node" -body {
     .tv insert {} end -id newnode -text "New node"
 } -result newnode
 
-test treeview-2.6 "insert -- make sure node was inserted" -constraints treeview -body {
+test treeview-2.6 "insert -- make sure node was inserted" -body {
     .tv children {}
 } -result [list newnode]
 
-test treeview-2.7 "insert -- prevent duplicate node names" -constraints treeview -body {
+test treeview-2.7 "insert -- prevent duplicate node names" -body {
     .tv insert {} end -id newnode
 } -returnCodes 1 -result "Item newnode already exists"
 
-test treeview-2.8 "insert -- new node at end" -constraints treeview -body {
+test treeview-2.8 "insert -- new node at end" -body {
     .tv insert {} end -id lastnode
     consistencyCheck .tv
     .tv children {}
@@ -98,52 +95,52 @@ test treeview-2.8 "insert -- new node at end" -constraints treeview -body {
 
 consistencyCheck .tv
 
-test treeview-2.9 "insert -- new node at beginning" -constraints treeview -body {
+test treeview-2.9 "insert -- new node at beginning" -body {
     .tv insert {} 0 -id firstnode
     consistencyCheck .tv
     .tv children {}
 } -result [list firstnode newnode lastnode]
 
-test treeview-2.10 "insert -- one more node" -constraints treeview -body {
+test treeview-2.10 "insert -- one more node" -body {
     .tv insert {} 2 -id onemore
     consistencyCheck .tv
     .tv children {}
 } -result [list firstnode newnode onemore lastnode]
 
-test treeview-2.11 "insert -- and another one" -constraints treeview -body {
+test treeview-2.11 "insert -- and another one" -body {
     .tv insert {} 2 -id anotherone
     consistencyCheck .tv
     .tv children {}
 } -result [list firstnode newnode anotherone onemore lastnode]
 
-test treeview-2.12 "insert -- one more at end" -constraints treeview -body {
+test treeview-2.12 "insert -- one more at end" -body {
     .tv insert {} end -id newlastone
     consistencyCheck .tv
     .tv children {}
 } -result [list firstnode newnode anotherone onemore lastnode newlastone]
 
-test treeview-2.13 "insert -- one more at beginning" -constraints treeview -body {
+test treeview-2.13 "insert -- one more at beginning" -body {
     .tv insert {} 0 -id newfirstone
     consistencyCheck .tv
     .tv children {}
 } -result [list newfirstone firstnode newnode anotherone onemore lastnode newlastone]
 
-test treeview-2.14 "insert -- bad options" -constraints treeview -body {
+test treeview-2.14 "insert -- bad options" -body {
     .tv insert {} end -badoption foo
 } -returnCodes 1 -result {unknown option "-badoption"}
 
-test treeview-2.15 "insert -- at position 0 w/no children" -constraints treeview -body {
+test treeview-2.15 "insert -- at position 0 w/no children" -body {
     .tv insert newnode 0 -id newnode.n2 -text "Foo"
     .tv children newnode
 } -result newnode.n2	;# don't crash
 
-test treeview-2.16 "insert -- insert way past end" -constraints treeview -body {
+test treeview-2.16 "insert -- insert way past end" -body {
     .tv insert newnode 99 -id newnode.n3 -text "Foo"
     consistencyCheck .tv
     .tv children newnode
 } -result [list newnode.n2 newnode.n3]
 
-test treeview-2.17 "insert -- insert before beginning" -constraints treeview -body {
+test treeview-2.17 "insert -- insert before beginning" -body {
     .tv insert newnode -1 -id newnode.n1 -text "Foo"
     consistencyCheck .tv
     .tv children newnode
@@ -151,19 +148,19 @@ test treeview-2.17 "insert -- insert before beginning" -constraints treeview -bo
 
 ###
 #
-test treeview-3.1 "parent" -constraints treeview -body {
+test treeview-3.1 "parent" -body {
     .tv parent newnode.n1
 } -result newnode
-test treeview-3.2 "parent - top-level node" -constraints treeview -body {
+test treeview-3.2 "parent - top-level node" -body {
     .tv parent newnode
 } -result {}
-test treeview-3.3 "parent - root node" -constraints treeview -body {
+test treeview-3.3 "parent - root node" -body {
     .tv parent {}
 } -result {}
-test treeview-3.4 "index" -constraints treeview -body {
+test treeview-3.4 "index" -body {
     list [.tv index newnode.n3] [.tv index newnode.n2] [.tv index newnode.n1]
 } -result [list 2 1 0]
-test treeview-3.5 "index - exhaustive test" -constraints treeview -body {
+test treeview-3.5 "index - exhaustive test" -body {
     set result [list]
     foreach item [.tv children {}] {
 	lappend result [.tv index $item]
@@ -171,14 +168,14 @@ test treeview-3.5 "index - exhaustive test" -constraints treeview -body {
     set result
 } -result [list 0 1 2 3 4 5 6]
 
-test treeview-3.6 "detach" -constraints treeview -body {
+test treeview-3.6 "detach" -body {
     .tv detach newnode
     consistencyCheck .tv
     .tv children {}
 } -result [list newfirstone firstnode anotherone onemore lastnode newlastone]
 # XREF: treeview-2.13
 
-test treeview-3.7 "detach didn't screw up internal links" -constraints treeview -body {
+test treeview-3.7 "detach didn't screw up internal links" -body {
     consistencyCheck .tv
     set result [list]
     foreach item [.tv children {}] {
@@ -187,36 +184,36 @@ test treeview-3.7 "detach didn't screw up internal links" -constraints treeview
     set result
 } -result [list 0 1 2 3 4 5]
 
-test treeview-3.8 "detached node has no parent, index 0" -constraints treeview -body {
+test treeview-3.8 "detached node has no parent, index 0" -body {
     list [.tv parent newnode] [.tv index newnode]
 } -result [list {} 0]
 # @@@ Can't distinguish detached nodes from first root node
 
-test treeview-3.9 "detached node's children undisturbed" -constraints treeview -body {
+test treeview-3.9 "detached node's children undisturbed" -body {
     .tv children newnode
 } -result [list newnode.n1 newnode.n2 newnode.n3]
 
-test treeview-3.10 "detach is idempotent" -constraints treeview -body {
+test treeview-3.10 "detach is idempotent" -body {
     .tv detach newnode
     consistencyCheck .tv
     .tv children {}
 } -result [list newfirstone firstnode anotherone onemore lastnode newlastone]
 
-test treeview-3.11 "Can't detach root item" -constraints treeview -body {
+test treeview-3.11 "Can't detach root item" -body {
     .tv detach [list {}]
     update
     consistencyCheck .tv
 } -returnCodes 1 -result "Cannot detach root item"
 consistencyCheck .tv
 
-test treeview-3.12 "Reattach" -constraints treeview -body {
+test treeview-3.12 "Reattach" -body {
     .tv move newnode {} end
     consistencyCheck .tv
     .tv children {}
 } -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode]
 
 # Bug # ?????
-test treeview-3.13 "Re-reattach" -constraints treeview -body {
+test treeview-3.13 "Re-reattach" -body {
     .tv move newnode {} end
     consistencyCheck .tv
     .tv children {}
@@ -228,88 +225,88 @@ catch {
     .tv insert newfirstone end -id x3
 }
 
-test treeview-3.14 "Duplicated entry in children list" -constraints treeview -body {
+test treeview-3.14 "Duplicated entry in children list" -body {
     .tv children newfirstone [list x3 x1 x2 x3]
     # ??? Maybe this should raise an error?
     consistencyCheck .tv
     .tv children newfirstone
 } -result [list x3 x1 x2]
 
-test treeview-3.14.1 "Duplicated entry in children list" -constraints treeview -body {
+test treeview-3.14.1 "Duplicated entry in children list" -body {
     .tv children newfirstone [list x1 x2 x3 x3 x2 x1]
     consistencyCheck .tv
     .tv children newfirstone
 } -result [list x1 x2 x3]
 
-test treeview-3.15 "Consecutive duplicate entries in children list" -constraints treeview -body {
+test treeview-3.15 "Consecutive duplicate entries in children list" -body {
     .tv children newfirstone [list x1 x2 x2 x3]
     consistencyCheck .tv
     .tv children newfirstone
 } -result [list x1 x2 x3]
 
-test treeview-3.16 "Insert child after self" -constraints treeview -body {
+test treeview-3.16 "Insert child after self" -body {
     .tv move x2 newfirstone 1 
     consistencyCheck .tv
     .tv children newfirstone
 } -result [list x1 x2 x3]
 
-test treeview-3.17 "Insert last child after self" -constraints treeview -body {
+test treeview-3.17 "Insert last child after self" -body {
     .tv move x3 newfirstone 2
     consistencyCheck .tv
     .tv children newfirstone
 } -result [list x1 x2 x3]
 
-test treeview-3.18 "Insert last child after end" -constraints treeview -body {
+test treeview-3.18 "Insert last child after end" -body {
     .tv move x3 newfirstone 3
     consistencyCheck .tv
     .tv children newfirstone
 } -result [list x1 x2 x3]
 
 
-test treeview-4.1 "opened - initial state" -constraints treeview -body {
+test treeview-4.1 "opened - initial state" -body {
     .tv item newnode -open
 } -result 0
-test treeview-4.2 "opened - open node" -constraints treeview -body {
+test treeview-4.2 "opened - open node" -body {
     .tv item newnode -open 1
     .tv item newnode -open
 } -result 1
-test treeview-4.3 "opened - closed node" -constraints treeview -body {
+test treeview-4.3 "opened - closed node" -body {
     .tv item newnode -open 0
     .tv item newnode -open
 } -result 0
 
-test treeview-5.1 "item -- error checks" -constraints treeview -body {
+test treeview-5.1 "item -- error checks" -body {
     .tv item newnode -text "Bad values" -values "{bad}list"
 } -returnCodes 1 -result "list element in braces followed by*" -match glob
 
-test treeview-5.2 "item -- error leaves options unchanged " -constraints treeview -body {
+test treeview-5.2 "item -- error leaves options unchanged " -body {
     .tv item newnode -text
 } -result "New node"
 
-test treeview-5.3 "Heading" -constraints treeview -body {
+test treeview-5.3 "Heading" -body {
     .tv heading #0 -text "Heading"
 }
 
-test treeview-5.4 "get cell" -constraints treeview -body {
+test treeview-5.4 "get cell" -body {
     set l [list a b c]
     .tv item newnode -values $l
     .tv set newnode 1 
 } -result b
 
-test treeview-5.5 "set cell" -constraints treeview -body {
+test treeview-5.5 "set cell" -body {
     .tv set newnode 1 XXX
     .tv item newnode -values 
 } -result [list a XXX c]
 
-test treeview-5.6 "set illegal cell" -constraints treeview -body {
+test treeview-5.6 "set illegal cell" -body {
     .tv set newnode #0 YYY
 } -returnCodes 1 -result "Display column #0 cannot be set"
 
-test treeview-5.7 "set illegal cell" -constraints treeview -body {
+test treeview-5.7 "set illegal cell" -body {
     .tv set newnode 3 YY	;# 3 == current #columns
 } -returnCodes 1 -result "Column index 3 out of bounds"
 
-test treeview-5.8 "set display columns" -constraints treeview -body {
+test treeview-5.8 "set display columns" -body {
     .tv configure -displaycolumns [list 2 1 0]
     .tv set newnode #1 X
     .tv set newnode #2 Y
@@ -317,23 +314,23 @@ test treeview-5.8 "set display columns" -constraints treeview -body {
     .tv item newnode -values
 } -result [list Z Y X]
 
-test treeview-5.9 "display columns part 2" -constraints treeview -body {
+test treeview-5.9 "display columns part 2" -body {
     list [.tv column #1 -id] [.tv column #2 -id] [.tv column #3 -id]
 } -result [list c b a]
 
-test treeview-5.10 "cannot set column -id" -constraints treeview -body {
+test treeview-5.10 "cannot set column -id" -body {
     .tv column #1 -id X
 } -returnCodes 1 -result "Attempt to change read-only option"
 
-test treeview-5.11 "get" -constraints treeview -body {
+test treeview-5.11 "get" -body {
     .tv set newnode #1
 } -result X
 
-test treeview-5.12 "get dictionary" -constraints treeview -body {
+test treeview-5.12 "get dictionary" -body {
     .tv set newnode
 } -result [list a Z b Y c X]
 
-test treeview-5.13 "get, no value" -constraints treeview -body {
+test treeview-5.13 "get, no value" -body {
     set newitem [.tv insert {} end]
     set result [.tv set $newitem #1]
     .tv delete $newitem
@@ -341,7 +338,7 @@ test treeview-5.13 "get, no value" -constraints treeview -body {
 } -result {}
 
 
-test treeview-6.1 "deletion - setup" -constraints treeview -body {
+test treeview-6.1 "deletion - setup" -body {
     .tv insert {} end -id dtest
     foreach id [list a b c d e] {
 	.tv insert dtest end -id $id
@@ -349,7 +346,7 @@ test treeview-6.1 "deletion - setup" -constraints treeview -body {
     .tv children dtest
 } -result [list a b c d e]
 
-test treeview-6.1.1 "delete" -constraints treeview -body {
+test treeview-6.1.1 "delete" -body {
     .tv delete b
     consistencyCheck .tv
     list [.tv exists b] [.tv children dtest]
@@ -357,13 +354,13 @@ test treeview-6.1.1 "delete" -constraints treeview -body {
 
 consistencyCheck .tv
 
-test treeview-6.2 "delete - duplicate items in list" -constraints treeview -body {
+test treeview-6.2 "delete - duplicate items in list" -body {
     .tv delete [list a e a e]
     consistencyCheck .tv
     .tv children dtest
 } -result [list c d]
 
-test treeview-6.3 "delete - descendants removed" -constraints treeview -body {
+test treeview-6.3 "delete - descendants removed" -body {
     .tv insert c  end -id c1
     .tv insert c  end -id c2
     .tv insert c1 end -id c11
@@ -373,7 +370,7 @@ test treeview-6.3 "delete - descendants removed" -constraints treeview -body {
     list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
 } -result [list 0 0 0 0]
 
-test treeview-6.4 "delete - delete parent and descendants" -constraints treeview -body {
+test treeview-6.4 "delete - delete parent and descendants" -body {
     .tv insert dtest end -id c
     .tv insert c  end -id c1
     .tv insert c  end -id c2
@@ -384,7 +381,7 @@ test treeview-6.4 "delete - delete parent and descendants" -constraints treeview
     list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
 } -result [list 0 0 0 0]
 
-test treeview-6.5 "delete - delete descendants and parent" -constraints treeview -body {
+test treeview-6.5 "delete - delete descendants and parent" -body {
     .tv insert dtest end -id c
     .tv insert c  end -id c1
     .tv insert c  end -id c2
@@ -395,12 +392,12 @@ test treeview-6.5 "delete - delete descendants and parent" -constraints treeview
     list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
 } -result [list 0 0 0 0]
 
-test treeview-6.6 "delete - end" -constraints treeview -body {
+test treeview-6.6 "delete - end" -body {
     consistencyCheck .tv
     .tv children dtest
 } -result [list d]
 
-test treeview-7.1 "move" -constraints treeview -body {
+test treeview-7.1 "move" -body {
     .tv insert d end -id d1
     .tv insert d end -id d2
     .tv insert d end -id d3
@@ -409,59 +406,59 @@ test treeview-7.1 "move" -constraints treeview -body {
     .tv children d
 } -result [list d3 d1 d2]
 
-test treeview-7.2 "illegal move" -constraints treeview -body {
+test treeview-7.2 "illegal move" -body {
    .tv move d d2 end
 } -returnCodes 1 -result "Cannot insert d as a descendant of d2" 
 
-test treeview-7.3 "illegal move has no effect" -constraints treeview -body {
+test treeview-7.3 "illegal move has no effect" -body {
     consistencyCheck .tv
     .tv children d 
 } -result [list d3 d1 d2]
 
-test treeview-7.4 "Replace children" -constraints treeview -body {
+test treeview-7.4 "Replace children" -body {
     .tv children d [list d3 d2 d1]
     consistencyCheck .tv
     .tv children d
 } -result [list d3 d2 d1]
 
-test treeview-7.5 "replace children - precondition" -constraints treeview -body {
+test treeview-7.5 "replace children - precondition" -body {
     # Just check to make sure the test suite so far has left
     # us in the state we expect to be in:
     list [.tv parent newnode] [.tv children newnode]
 } -result [list {} [list newnode.n1 newnode.n2 newnode.n3]]
 
-test treeview-7.6 "Replace children - illegal move" -constraints treeview -body {
+test treeview-7.6 "Replace children - illegal move" -body {
     .tv children newnode.n1 [list newnode.n1 newnode.n2 newnode.n3]
 } -returnCodes 1 -result "Cannot insert newnode.n1 as a descendant of newnode.n1"
 
 consistencyCheck .tv
 
-test treeview-8.0 "Selection set" -constraints treeview -body {
+test treeview-8.0 "Selection set" -body {
     .tv selection set [list newnode.n1 newnode.n3 newnode.n2]
     .tv selection
 } -result [list newnode.n1 newnode.n2 newnode.n3]
 
-test treeview-8.1 "Selection add" -constraints treeview -body {
+test treeview-8.1 "Selection add" -body {
     .tv selection add [list newnode]
     .tv selection
 } -result [list newnode newnode.n1 newnode.n2 newnode.n3]
 
-test treeview-8.2 "Selection toggle" -constraints treeview -body {
+test treeview-8.2 "Selection toggle" -body {
     .tv selection toggle [list newnode.n2 d3]
     .tv selection
 } -result [list newnode newnode.n1 newnode.n3 d3]
 
-test treeview-8.3 "Selection remove" -constraints treeview -body {
+test treeview-8.3 "Selection remove" -body {
     .tv selection remove [list newnode.n2 d3]
     .tv selection
 } -result [list newnode newnode.n1 newnode.n3]
 
-test treeview-8.4 "Selection - clear" -constraints treeview -body {
+test treeview-8.4 "Selection - clear" -body {
     .tv selection set {}
     .tv selection
 } -result {}
 
-test treeview-8.5 "Selection - bad operation" -constraints treeview -body {
+test treeview-8.5 "Selection - bad operation" -body {
     .tv selection badop foo
 } -returnCodes 1 -match glob -result {bad selection operation "badop": must be *}
 
@@ -470,7 +467,7 @@ test treeview-8.5 "Selection - bad operation" -constraints treeview -body {
 proc scrollcallback {args} {
     set ::scrolldata $args
 }
-test treeview-9.0 "scroll callback - empty tree" -constraints treeview -body {
+test treeview-9.0 "scroll callback - empty tree" -body {
     .tv configure -yscrollcommand scrollcallback
     .tv delete [.tv children {}]
     update
@@ -489,6 +486,6 @@ test treeview-10.1 "Root node properly initialized (#1541739)" -setup {
     .tv see a
 } -cleanup {
     destroy .tv
-} -constraints treeview
+}
 
 tcltest::cleanupTests