diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | library/ttk/treeview.tcl | 20 | ||||
| -rw-r--r-- | library/ttk/utils.tcl | 62 | ||||
| -rw-r--r-- | tests/ttk/treeview.test | 161 |
4 files changed, 149 insertions, 100 deletions
@@ -1,3 +1,9 @@ +2008-01-06 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/treeview.tcl, library/ttk/utils.tcl: + Fix MouseWheel bindings for ttk::treeview widget + (Fixes #1442006, #1821939, #1862692) + 2008-01-02 Don Porter <dgp@users.sourceforge.net> * generic/tk.h: Bump version number to 8.5.1b1 to distinguish diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 3ccb746..a5ebcb2 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -1,4 +1,4 @@ -# $Id: treeview.tcl,v 1.2 2006/12/18 19:33:14 jenglish Exp $ +# $Id: treeview.tcl,v 1.3 2008/01/06 19:16:12 jenglish Exp $ # # ttk::treeview widget bindings and utilities. # @@ -56,13 +56,7 @@ bind Treeview <Shift-ButtonPress-1> \ bind Treeview <Control-ButtonPress-1> \ { ttk::treeview::Select %W %x %y toggle } -# Standard mousewheel bindings: -# -bind Treeview <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units } -if {[string equal "x11" [tk windowingsystem]]} { - bind Treeview <ButtonPress-4> { %W yview scroll -5 units } - bind Treeview <ButtonPress-5> { %W yview scroll 5 units } -} +ttk::copyBindings TtkScrollable Treeview ### Binding procedures. # @@ -163,7 +157,7 @@ proc ttk::treeview::Select {w x y op} { } } -## DoubleClick -- Double-ButtonPress-1 binding. +## DoubleClick -- Double-ButtonPress-1 binding. # proc ttk::treeview::DoubleClick {w x y} { if {[set row [$w identify row $x $y]] ne ""} { @@ -261,7 +255,7 @@ proc ttk::treeview::heading.release {w} { # ## SelectOp $w $item [ choose | extend | toggle ] -- -# Dispatch to appropriate selection operation +# Dispatch to appropriate selection operation # depending on current value of -selectmode. # proc ttk::treeview::SelectOp {w item op} { @@ -282,10 +276,10 @@ proc ttk::treeview::select.extend.browse {w item} { BrowseTo $w $item } ## -selectmode multiple: # -proc ttk::treeview::select.choose.extended {w item} { +proc ttk::treeview::select.choose.extended {w item} { BrowseTo $w $item } -proc ttk::treeview::select.toggle.extended {w item} { +proc ttk::treeview::select.toggle.extended {w item} { $w selection toggle $item } proc ttk::treeview::select.extend.extended {w item} { @@ -304,7 +298,7 @@ proc ttk::treeview::select.extend.extended {w item} { # in preorder traversal order. $item1 and $item2 may be # in either order. # -# NOTES: +# NOTES: # This routine is O(N) in the size of the tree. # There's probably a way to do this that's O(N) in the number # of items returned, but I'm not clever enough to figure it out. diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 1e277be..1de8ec8 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -1,5 +1,5 @@ # -# $Id: utils.tcl,v 1.5 2007/12/13 15:27:08 dgp Exp $ +# $Id: utils.tcl,v 1.6 2008/01/06 19:16:12 jenglish Exp $ # # Utilities for widget implementations. # @@ -48,7 +48,7 @@ proc ttk::clickToFocus {w} { # # See also: tk::FocusOK # -# Note: This routine doesn't implement the same fallback heuristics +# Note: This routine doesn't implement the same fallback heuristics # as tk::FocusOK. # proc ttk::takesFocus {w} { @@ -78,8 +78,8 @@ proc ttk::takesFocus {w} { # proc ttk::focusFirst {w} { - if {[ttk::takesFocus $w]} { - return $w + if {[ttk::takesFocus $w]} { + return $w } foreach child [winfo children $w] { if {[set c [ttk::focusFirst $child]] ne ""} { @@ -239,7 +239,7 @@ proc ttk::CancelRepeat {} { after cancel $Repeat(timer) } -### Miscellaneous. +### Bindings. # ## ttk::copyBindings $from $to -- @@ -251,4 +251,56 @@ proc ttk::copyBindings {from to} { } } +## Standard mousewheel bindings. +# +# Usage: [ttk::copyBindings TtkScrollable $bindtag] +# adds mousewheel support to a scrollable widget. +# +# Platform inconsistencies: +# +# On X11, the server typically maps the mouse wheel to Button4 and Button5. +# +# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events. +# +# On Windows, %D must be scaled by a factor of 120. +# In addition, Tk redirects mousewheel events to the window with +# keyboard focus instead of sending them to the window under the pointer. +# We do not attempt to fix that here, see also TIP#171. +# +# OSX conventionally uses Shift+MouseWheel for horizontal scrolling, +# and Option+MouseWheel for accelerated scrolling. +# +# The Shift+MouseWheel behavior is not conventional on Windows or most +# X11 toolkits, but it's useful. +# +# MouseWheel scrolling is accelerated on X11, which is conventional +# for Tk and appears to be conventional for other toolkits (although +# Gtk+ and Qt do not appear to use as large a factor). +# + +switch -- [tk windowingsystem] { + x11 { + bind TtkScrollable <ButtonPress-4> { %W yview scroll -5 units } + bind TtkScrollable <ButtonPress-5> { %W yview scroll 5 units } + bind TtkScrollable <Shift-ButtonPress-4> { %W xview scroll -5 units } + bind TtkScrollable <Shift-ButtonPress-5> { %W xview scroll 5 units } + } + win32 { + bind TtkScrollable <MouseWheel> \ + { %W yview scroll [expr {-(%D/120)}] units } + bind TtkScrollable <Shift-MouseWheel> \ + { %W xview scroll [expr {-(%D/120)}] units } + } + aqua { + bind TtkScrollable <MouseWheel> \ + { %W yview scroll [expr {-(%D)}] units } + bind TtkScrollable <Shift-MouseWheel> \ + { %W xview scroll [expr {-(%D)}] units } + bind TtkScrollable <Option-MouseWheel> \ + { %W yview scroll [expr {-10*(%D)}] units } + bind TtkScrollable <Shift-Option-MouseWheel> \ + { %W xview scroll [expr {-10*(%D)}] units } + } +} + #*EOF* 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 |