Major backport of 8.6 Ttk for 8.5.9. Most changes were only being

        committed to head (8.6), although they could apply for 8.5 as well.
        This re-sync makes future work easier to maintain and adds some
        useful work for 8.5 users. Notable changes:
        - Lots of code cleanup
        - Some bug fixes never backported
        - Addition of ttk::spinbox
        - minor color changes
        - Improved Vista/7 styling
        - Move to tile version 0.8.6 (pseudo-package)
        - ABI and API compatible (even $w identify)
        - minor new features (extended $w identify)

8 files changed, 761 insertions, 147 deletions

diff --git a/tests/ttk/checkbutton.test b/tests/ttk/checkbutton.test
new file mode 100644
index 0000000..49c62dd
--- /dev/null
+++ b/tests/ttk/checkbutton.test
@@ -0,0 +1,49 @@
+# $Id: checkbutton.test,v 1.1.2.2 2010/08/26 02:06:10 hobbs Exp $
+#
+# ttk::checkbutton widget tests.
+#
+
+package require Tk
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test checkbutton-1.1 "Checkbutton check" -body {
+    pack [ttk::checkbutton .cb -text "TCheckbutton" -variable cb]
+}
+test checkbutton-1.2 "Checkbutton invoke" -body {
+    .cb invoke
+    list [set ::cb] [.cb instate selected]
+} -result [list 1 1]
+test checkbutton-1.3 "Checkbutton reinvoke" -body {
+    .cb invoke
+    list [set ::cb] [.cb instate selected]
+} -result [list 0 0]
+
+test checkbutton-1.4 "Checkbutton variable" -body {
+    set result []
+    set ::cb 1
+    lappend result [.cb instate selected]
+    set ::cb 0
+    lappend result [.cb instate selected]
+} -result {1 0}
+
+test checkbutton-1.5 "Unset checkbutton variable" -body {
+    set result []
+    unset ::cb
+    lappend result [.cb instate alternate] [info exists ::cb]
+    set ::cb 1
+    lappend result [.cb instate alternate] [info exists ::cb]
+} -result {1 0 0 1}
+
+# See #1257319
+test checkbutton-1.6 "Checkbutton default variable" -body {
+    destroy .cb ; unset -nocomplain {} ; set result [list]
+    ttk::checkbutton .cb -onvalue on -offvalue off
+    lappend result [.cb cget -variable] [info exists .cb] [.cb state]
+    .cb invoke
+    lappend result [info exists .cb] [set .cb] [.cb state]
+    .cb invoke
+    lappend result [info exists .cb] [set .cb] [.cb state]
+} -result [list .cb 0 alternate   1 on selected  1 off {}]
+
+tcltest::cleanupTests
diff --git a/tests/ttk/combobox.test b/tests/ttk/combobox.test
index 8f25a81..43f3cf1 100644
--- a/tests/ttk/combobox.test
+++ b/tests/ttk/combobox.test
@@ -56,8 +56,8 @@ test combobox-1890211 "ComboboxSelected event after listbox unposted" -body {
     lappend result Start 0 [.cb get]
     ttk::combobox::Post .cb
     lappend result Post [winfo ismapped .cb.popdown] [.cb get]
-    .cb.popdown.l selection clear 0 end; .cb.popdown.l selection set 1
-    ttk::combobox::LBSelected .cb.popdown.l
+    .cb.popdown.f.l selection clear 0 end; .cb.popdown.f.l selection set 1
+    ttk::combobox::LBSelected .cb.popdown.f.l
     lappend result Select [winfo ismapped .cb.popdown] [.cb get]
     update
     set result
diff --git a/tests/ttk/radiobutton.test b/tests/ttk/radiobutton.test
new file mode 100644
index 0000000..6858659
--- /dev/null
+++ b/tests/ttk/radiobutton.test
@@ -0,0 +1,49 @@
+# $Id: radiobutton.test,v 1.1.2.2 2010/08/26 02:06:10 hobbs Exp $
+#
+# ttk::radiobutton widget tests.
+#
+
+package require Tk
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test radiobutton-1.1 "Radiobutton check" -body {
+    pack \
+    	[ttk::radiobutton .rb1 -text "One" -variable choice -value 1] \
+	[ttk::radiobutton .rb2 -text "Two" -variable choice -value 2] \
+	[ttk::radiobutton .rb3 -text "Three" -variable choice -value 3] \
+	;
+}
+test radiobutton-1.2 "Radiobutton invoke" -body {
+    .rb1 invoke
+    set ::choice
+} -result 1
+
+test radiobutton-1.3 "Radiobutton state" -body {
+    .rb1 instate selected
+} -result 1
+
+test radiobutton-1.4 "Other radiobutton invoke" -body {
+    .rb2 invoke
+    set ::choice
+} -result 2
+
+test radiobutton-1.5 "Other radiobutton state" -body {
+    .rb2 instate selected
+} -result 1
+
+test radiobutton-1.6 "First radiobutton state" -body {
+    .rb1 instate selected
+} -result 0
+
+test radiobutton-1.7 "Unset radiobutton variable" -body {
+    unset ::choice
+    list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate]
+} -result {0 1 1}
+
+test radiobutton-1.8 "Reset radiobutton variable" -body {
+    set ::choice 2
+    list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate]
+} -result {1 0 0}
+
+tcltest::cleanupTests
diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test
new file mode 100644
index 0000000..3397e37
--- /dev/null
+++ b/tests/ttk/spinbox.test
@@ -0,0 +1,280 @@
+#
+# ttk::spinbox widget tests
+#
+
+package require Tk
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test spinbox-1.0 "Spinbox tests -- setup" -body {
+    ttk::spinbox .sb
+} -cleanup { destroy .sb } -result .sb
+
+test spinbox-1.1 "Bad -values list" -setup {
+    ttk::spinbox .sb
+} -body {
+    .sb configure -values "bad \{list"
+} -cleanup {
+    destroy .sb
+} -returnCodes error -result "unmatched open brace in list"
+
+test spinbox-1.3.1 "get retrieves value" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb set 50
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result 50
+
+test spinbox-1.3.2 "get retrieves value" -setup {
+    ttk::spinbox .sb -from 0 -to 100 -values 55
+} -body {
+     .sb set 55
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result 55
+
+test spinbox-1.4.1 "set changes value" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb set 33
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result 33
+
+test spinbox-1.4.2 "set changes value" -setup {
+    ttk::spinbox .sb -from 0 -to 100 -values 55
+} -body {
+    .sb set 33
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result 33
+
+
+test spinbox-1.6.1 "insert start" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb set 5
+    .sb insert 0 4
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result 45
+
+test spinbox-1.6.2 "insert end" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb set 5
+    .sb insert end 4
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result 54
+
+test spinbox-1.6.3 "insert invalid index" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb set 5
+    .sb insert 100 4
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result 54
+
+test spinbox-1.7.1 "-command option: set doesnt fire" -setup {
+    ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1}
+} -body {
+    set ::spinbox_test 0
+    .sb set 50
+    set ::spinbox_test
+} -cleanup {
+    destroy .sb
+} -result 0
+
+test spinbox-1.7.2 "-command option: button handler will fire" -setup {
+    ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1}
+} -body {
+    set ::spinbox_test 0
+    .sb set 50
+    event generate .sb <<Increment>>
+    set ::spinbox_test
+} -cleanup {
+    destroy .sb
+} -result 1
+
+test spinbox-1.8.1 "option -validate" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb configure -validate all
+    .sb cget -validate
+} -cleanup {
+    destroy .sb
+} -result {all}
+
+test spinbox-1.8.2 "option -validate" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb configure -validate key
+    .sb configure -validate focus
+    .sb configure -validate focusin
+    .sb configure -validate focusout
+    .sb configure -validate none
+    .sb cget -validate
+} -cleanup {
+    destroy .sb
+} -result {none}
+
+test spinbox-1.8.3 "option -validate" -setup {
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb configure -validate bogus
+} -cleanup {
+    destroy .sb
+} -returnCodes error -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}
+
+test spinbox-1.8.4 "-validate option: " -setup {
+    set ::spinbox_test {}
+    ttk::spinbox .sb -from 0 -to 100
+} -body {
+    .sb configure -validate all -validatecommand {lappend ::spinbox_test %P}
+    pack .sb
+    .sb set 50
+    focus .sb
+    after 100 {set ::spinbox_wait 1} ; vwait ::spinbox_wait
+    set ::spinbox_test
+} -cleanup {
+    destroy .sb
+} -result {50}
+
+
+test spinbox-2.0 "current command -- unset should be 0" -constraints nyi -setup {
+    ttk::spinbox .sb -values [list a b c d e a]
+} -body {
+    .sb current
+} -cleanup {
+    destroy .sb
+} -result 0
+# @@@ for combobox, this is -1.
+
+test spinbox-2.1 "current command -- set index" -constraints nyi -setup {
+    ttk::spinbox .sb -values [list a b c d e a]
+} -body {
+    .sb current 5
+    .sb get
+} -cleanup {
+    destroy .sb
+} -result a
+
+test spinbox-2.2 "current command -- change -values" -constraints nyi -setup {
+    ttk::spinbox .sb -values [list a b c d e a]
+} -body {
+    .sb current 5
+    .sb configure -values [list c b a d e]
+    .sb current
+} -cleanup {
+    destroy .sb
+} -result 2
+
+test spinbox-2.3 "current command -- change value" -constraints nyi -setup {
+    ttk::spinbox .sb -values [list c b a d e]
+} -body {
+    .sb current 2
+    .sb set "b"
+    .sb current
+} -cleanup {
+    destroy .sb
+} -result 1
+
+test spinbox-2.4 "current command -- value not in list" -constraints nyi -setup {
+    ttk::spinbox .sb -values [list c b a d e]
+} -body {
+    .sb current 2
+    .sb set "z"
+    .sb current
+} -cleanup {
+    destroy .sb
+} -result -1
+
+# nostomp: NB intentional difference between ttk::spinbox and tk::spinbox;
+# see also #1439266
+#
+test spinbox-nostomp-1 "don't stomp on -variable (init; -from/to)" -body {
+    set SBV 55
+    ttk::spinbox .sb -textvariable SBV -from 0 -to 100 -increment 5
+    list $SBV [.sb get]
+} -cleanup {
+   unset SBV
+   destroy .sb
+} -result [list 55 55]
+
+test spinbox-nostomp-2 "don't stomp on -variable (init; -values)" -body {
+    set SBV Apr
+    ttk::spinbox .sb -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug}
+    list $SBV [.sb get]
+} -cleanup {
+   unset SBV
+   destroy .sb
+} -result [list Apr Apr]
+
+test spinbox-nostomp-3 "don't stomp on -variable (configure; -from/to)" -body {
+    set SBV 55
+    ttk::spinbox .sb
+    .sb configure -textvariable SBV -from 0 -to 100 -increment 5
+    list $SBV [.sb get]
+} -cleanup {
+   unset SBV
+   destroy .sb
+} -result [list 55 55]
+
+test spinbox-nostomp-4 "don't stomp on -variable (configure; -values)" -body {
+    set SBV Apr
+    ttk::spinbox .sb 
+    .sb configure -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug}
+    list $SBV [.sb get]
+} -cleanup {
+   unset SBV
+   destroy .sb
+} -result [list Apr Apr]
+
+test spinbox-dieoctaldie-1 "Cope with leading zeros" -body {
+    # See SF#2358545 -- ttk::spinbox also affected
+    set secs 07
+    ttk::spinbox .sb -from 0 -to 59 -format %02.0f -textvariable secs
+
+    set result [list $secs]
+    event generate .sb <<Increment>>; lappend result $secs
+    event generate .sb <<Increment>>; lappend result $secs
+    event generate .sb <<Increment>>; lappend result $secs
+    event generate .sb <<Increment>>; lappend result $secs
+
+    event generate .sb <<Decrement>>; lappend result $secs
+    event generate .sb <<Decrement>>; lappend result $secs
+    event generate .sb <<Decrement>>; lappend result $secs
+    event generate .sb <<Decrement>>; lappend result $secs
+
+    set result
+} -result [list 07 08 09 10 11 10 09 08 07] -cleanup { 
+    destroy .sb
+    unset secs
+}
+
+test spinbox-dieoctaldie-2 "Cope with general bad input" -body {
+    set result [list]
+    ttk::spinbox .sb -from 0 -to 100 -format %03.0f
+    .sb set asdfasdf ; lappend result [.sb get]
+    event generate .sb <<Increment>> ; lappend result [.sb get]
+    .sb set asdfasdf ; lappend result [.sb get]
+    event generate .sb <<Decrement>> ; lappend result [.sb get]
+} -result [list asdfasdf 000 asdfasdf 000] -cleanup {
+    destroy .sb
+}
+
+tcltest::cleanupTests
+
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/ttk/treetags.test b/tests/ttk/treetags.test
index fe4dbcd..5f1287d 100644
--- a/tests/ttk/treetags.test
+++ b/tests/ttk/treetags.test
@@ -1,48 +1,147 @@
 #
-# $Id: treetags.test,v 1.2 2007/05/18 16:53:18 dgp Exp $
+# $Id: treetags.test,v 1.2.4.1 2010/08/26 02:06:10 hobbs Exp $
 #
 
-package require Tk 8.5
+package require Tk
 package require tcltest ; namespace import -force tcltest::*
 loadTestedCommands
-tk useinputmethods 0
 
-testConstraint treeview [llength [info commands ttk::treeview]]
-testConstraint nyi 0
+### treeview tag invariants:
+#
+
+proc assert {expr {message ""}} {
+    if {![uplevel 1 [list expr $expr]]} {
+        error "PANIC: $message ($expr failed)"
+    }
+}
+proc in {e l} { expr {[lsearch -exact $l $e] >= 0} }
+
+proc itemConstraints {tv item} {
+    # $tag in [$tv item $item -tags] <==> [$tv tag has $tag $item]
+    foreach tag [$tv item $item -tags] {
+	assert {[in $item [$tv tag has $tag]]}
+    }
+    foreach child [$tv children $item] {
+	itemConstraints $tv $child
+    }
+}
+
+proc treeConstraints {tv} {
+    # $item in [$tv tag has $tag] <==> [$tv tag has $tag $item]
+    #
+    foreach tag [$tv tag names] {
+	foreach item [$tv tag has $tag] {
+	    assert {[in $tag [$tv item $item -tags]]}
+	}
+    }
 
-test treetags-1.0 "Setup" -constraints treeview -body {
+    itemConstraints $tv {}
+}
+#
+###
+
+test treetags-1.0 "Setup" -body {
     set tv [ttk::treeview .tv]
     .tv insert {} end -id item1 -text "Item 1"
-    pack .tv 
+    pack .tv
+} -cleanup {
+    treeConstraints $tv
 }
 
-test treetags-1.1 "Bad tag list" -constraints treeview -body {
+test treetags-1.1 "Bad tag list" -body {
     $tv item item1 -tags {bad {list}here bad}
+    $tv item item1 -tags
 } -returnCodes error -result "list element in braces *" -match glob
 
-test treetags-1.2 "Good tag list" -constraints treeview -body {
+test treetags-1.2 "Good tag list" -body {
     $tv item item1 -tags tag1
     $tv item item1 -tags
+} -cleanup {
+    assert {[$tv tag has tag1 item1]}
+    treeConstraints $tv
 } -result [list tag1]
 
-test treetags-1.3 "Bad events" -constraints treeview -body {
-    $tv tag bind bad <Enter> { puts "Entered!" }
-} -returnCodes 1 -result "unsupported event <Enter>*" -match glob
+test treetags-1.3 "tag has - test" -body {
+    $tv insert {} end -id item2 -text "Item 2" -tags tag2
+    set result [list]
+    foreach item {item1 item2} {
+    	foreach tag {tag1 tag2 tag3} {
+	    lappend result $item $tag [$tv tag has $tag $item]
+	}
+    }
+    set result
+} -cleanup {
+    treeConstraints $tv
+} -result [list \
+	item1 tag1 1 item1 tag2 0 item1 tag3 0 \
+	item2 tag1 0 item2 tag2 1 item2 tag3 0 ]
+
+test treetags-1.4 "tag has - query" -body {
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list]]
+
+test treetags-1.5 "tag add" -body {
+    $tv tag add tag3 {item1 item2}
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list item1 item2]]
+
+test treetags-1.6 "tag remove - list" -body {
+    $tv tag remove tag3 {item1 item2}
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list]]
+
+test treetags-1.7 "tag remove - all items" -body {
+    $tv tag remove tag1
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list] [list item2] [list]]
+
+test treetags-1.8 "tag names" -body {
+    lsort [$tv tag names]
+} -result [list tag1 tag2 tag3]
+
+test treetags-1.9 "tag names - tag added to item" -body {
+    $tv item item1 -tags tag4 
+    lsort [$tv tag names]
+} -result [list tag1 tag2 tag3 tag4]
+
+test treetags-1.10 "tag names - tag configured" -body {
+    $tv tag configure tag5
+    lsort [$tv tag names]
+} -result [list tag1 tag2 tag3 tag4 tag5]
+
+test treetags-1.end "cleanup" -body {
+    $tv item item1 -tags tag1
+    $tv item item2 -tags tag2
+    list [$tv tag has tag1] [$tv tag has tag2] [$tv tag has tag3]
+} -cleanup {
+    treeConstraints $tv
+} -result [list [list item1] [list item2] [list]]
 
-test treetags-2.0 "tag bind" -constraints treeview -body {
+test treetags-2.0 "tag bind" -body {
     $tv tag bind tag1 <KeyPress> {set ::KEY %A}
     $tv tag bind tag1 <KeyPress>
+} -cleanup {
+    treeConstraints $tv
 } -result {set ::KEY %A}
 
-test treetags-2.1 "Events delivered to tags" -constraints treeview -body {
+test treetags-2.1 "Events delivered to tags" -body {
     focus -force $tv ; update	;# needed so [event generate] delivers KeyPress
     $tv focus item1
-    event generate .tv <KeyPress-a>
+    event generate $tv <KeyPress-a>
     set ::KEY
+} -cleanup {
+    treeConstraints $tv
 } -result a
 
-test treetags-2.2 "Events delivered to correct tags" -constraints treeview -body {
-    $tv insert {} end -id item2 -tags tag2
+test treetags-2.2 "Events delivered to correct tags" -body {
     $tv tag bind tag2 <KeyPress> [list set ::KEY2 %A]
 
     $tv focus item1
@@ -51,9 +150,11 @@ test treetags-2.2 "Events delivered to correct tags" -constraints treeview -body
     event generate $tv <KeyPress-c>
 
     list $::KEY $::KEY2
+} -cleanup {
+    treeConstraints $tv
 } -result [list b c]
 
-test treetags-2.3 "Virtual events delivered to focus item" -constraints treeview -body {
+test treetags-2.3 "Virtual events delivered to focus item" -body {
     set ::bong 0
     $tv tag bind tag2 <<Bing>> { incr bong }
     $tv focus item2
@@ -61,18 +162,63 @@ test treetags-2.3 "Virtual events delivered to focus item" -constraints treeview
     $tv focus item1
     event generate $tv <<Bing>>
     set bong
+} -cleanup {
+    treeConstraints $tv
 } -result 1
 
+test treetags-2.4 "Bad events" -body {
+    $tv tag bind bad <Enter> { puts "Entered!" }
+} -returnCodes 1 -result "unsupported event <Enter>*" -match glob
 
-test treetags-3.0 "tag configure" -constraints treeview -body {
+test treetags-3.0 "tag configure - set" -body {
     $tv tag configure tag1 -foreground blue -background red
+} -cleanup {
+    treeConstraints $tv
 } -result {}
 
-test treetags-3.1 "tag configure" -constraints treeview -body {
+test treetags-3.1 "tag configure - get" -body {
     $tv tag configure tag1 -foreground
-} -result [list blue]
+} -cleanup {
+    treeConstraints $tv
+} -result blue
+
+# @@@ fragile test
+test treetags-3.2 "tag configure - enumerate" -body {
+    $tv tag configure tag1
+} -cleanup {
+    treeConstraints $tv
+} -result [list \
+    -text {} -image {} -anchor {} -background red -foreground blue -font {} \
+]
+
+# The next test exercises tag resource management.
+# If options are not properly freed, the message:
+# Test file error: "Font times 20 still in cache."
+# will show up on stderr at program exit.
+#
+test treetags-3.3 "tag configure - set font" -body {
+    $tv tag configure tag2 -font {times 20}
+}
+
+test treetags-3.4 "stomp tags in tag binding procedure" -body {
+    set result [list]
+    $tv tag bind rm1 <<Remove>> { lappend ::result rm1 [%W focus] <<Remove>> }
+    $tv tag bind rm2 <<Remove>> {
+    	lappend ::result rm2 [%W focus] <<Remove>> 
+	%W item [%W focus] -tags {tag1}
+    }
+    $tv tag bind rm3 <<Remove>> { lappend ::result rm3 [%W focus] <<Remove>> }
 
+    $tv item item1 -tags {rm1 rm2 rm3} 
+    $tv focus item1
+    event generate $tv <<Remove>>
+    set result
+} -cleanup {
+    treeConstraints $tv
+} -result [list rm1 item1 <<Remove>> rm2 item1 <<Remove>> rm3 item1 <<Remove>>]
+
+#
 
-test treetags-end "Cleanup" -constraints treeview -body { destroy .tv }
+test treetags-end "Cleanup" -body { destroy $tv }
 
 tcltest::cleanupTests
diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test
index c97b27a..5bc7a80 100644
--- a/tests/ttk/treeview.test
+++ b/tests/ttk/treeview.test
@@ -1,5 +1,5 @@
 #
-# $Id: treeview.test,v 1.3.2.2 2010/05/31 17:22:49 jenglish Exp $
+# $Id: treeview.test,v 1.3.2.3 2010/08/26 02:06:10 hobbs Exp $
 #
 # [7Jun2005] TO CHECK: [$tv see {}] -- shouldn't work (at least, shouldn't do
 # what it currently does)
@@ -245,7 +245,7 @@ test treeview-3.15 "Consecutive duplicate entries in children list" -body {
 } -result [list x1 x2 x3]
 
 test treeview-3.16 "Insert child after self" -body {
-    .tv move x2 newfirstone 1 
+    .tv move x2 newfirstone 1
     consistencyCheck .tv
     .tv children newfirstone
 } -result [list x1 x2 x3]
@@ -262,7 +262,6 @@ test treeview-3.18 "Insert last child after end" -body {
     .tv children newfirstone
 } -result [list x1 x2 x3]
 
-
 test treeview-4.1 "opened - initial state" -body {
     .tv item newnode -open
 } -result 0
@@ -290,12 +289,12 @@ test treeview-5.3 "Heading" -body {
 test treeview-5.4 "get cell" -body {
     set l [list a b c]
     .tv item newnode -values $l
-    .tv set newnode 1 
+    .tv set newnode 1
 } -result b
 
 test treeview-5.5 "set cell" -body {
     .tv set newnode 1 XXX
-    .tv item newnode -values 
+    .tv item newnode -values
 } -result [list a XXX c]
 
 test treeview-5.6 "set illegal cell" -body {
@@ -408,11 +407,11 @@ test treeview-7.1 "move" -body {
 
 test treeview-7.2 "illegal move" -body {
    .tv move d d2 end
-} -returnCodes 1 -result "Cannot insert d as a descendant of d2" 
+} -returnCodes 1 -result "Cannot insert d as a descendant of d2"
 
 test treeview-7.3 "illegal move has no effect" -body {
     consistencyCheck .tv
-    .tv children d 
+    .tv children d
 } -result [list d3 d1 d2]
 
 test treeview-7.4 "Replace children" -body {
@@ -474,8 +473,128 @@ test treeview-9.0 "scroll callback - empty tree" -body {
     set ::scrolldata
 } -result [list 0.0 1.0]
 
-### NEED: tests for focus item, selection
+### identify tests:
+#
+proc identify* {tv comps args} {
+    foreach {x y} $args {
+	foreach comp $comps {
+	    lappend result [$tv identify $comp $x $y]
+	}
+    }
+    return $result
+}
 
+# get list of column IDs from list of display column ids.
+#
+proc columnids {tv dcols} {
+    set result [list]
+    foreach dcol $dcols {
+	if {[catch {
+	    lappend result [$tv column $dcol -id]
+	}]} {
+	    lappend result ERROR
+	}
+    }
+    return $result
+}
+
+test treeview-identify-setup "identify series - setup" -body {
+    destroy .tv
+    ttk::setTheme default
+    ttk::treeview .tv -columns [list A B C]
+    .tv insert {} end -id branch -text branch -open true
+    .tv insert branch end -id item1 -text item1
+    .tv insert branch end -id item2 -text item2
+    .tv insert branch end -id item3 -text item3
+
+    .tv column #0 -width 50	;# 0-50
+    .tv column A -width 50	;# 50-100
+    .tv column B -width 50	;# 100-150
+    .tv column C -width 50	;# 150-200 (plus slop for margins)
+
+    wm geometry . {} ; pack .tv ; update
+}
+
+test treeview-identify-1 "identify heading" -body {
+    .tv configure -show {headings tree}
+    update idletasks
+    identify* .tv {region column} 10 10
+} -result [list heading #0]
+
+test treeview-identify-2 "identify columns" -body {
+    .tv configure -displaycolumns #all
+    update idletasks
+    columnids .tv [identify* .tv column 25 10  75 10  125 10  175 10]
+} -result [list {} A B C]
+
+test treeview-identify-3 "reordered columns" -body {
+    .tv configure -displaycolumns {B A C}
+    update idletasks
+    columnids .tv [identify* .tv column 25 10  75 10  125 10  175 10]
+} -result [list {} B A C]
+
+test treeview-identify-4 "no tree column" -body {
+    .tv configure -displaycolumns #all -show {headings}
+    update idletasks
+    identify* .tv {region column} 25 10  75 10  125 10  175 10
+} -result [list heading #1 heading #2 heading #3 nothing {}]
+
+# Item height in default theme is 20px
+test treeview-identify-5 "vertical scan - no headings" -body {
+    .tv configure -displaycolumns #all -show {tree}
+    update idletasks
+    identify* .tv {region item} 25 10  25 30  25 50  25 70  25 90
+} -result [list tree branch tree item1 tree item2 tree item3 nothing {}]
+
+test treeview-identify-6 "vertical scan - with headings" -body {
+    .tv configure -displaycolumns #all -show {tree headings}
+    update idletasks
+    identify* .tv {region item} 25 10  25 30  25 50  25 70  25 90
+} -result [list heading {} tree branch tree item1 tree item2 tree item3]
+
+test treeview-identify-7 "vertical scan - headings, no tree" -body {
+    .tv configure -displaycolumns #all -show {headings}
+    update idletasks
+    identify* .tv {region item} 25 10  25 30  25 50  25 70  25 90
+} -result [list heading {} cell branch cell item1 cell item2 cell item3]
+
+# In default theme, -indent and -itemheight both 20px
+# Disclosure element name is "Treeitem.indicator"
+set disclosure "*.indicator"
+test treeview-identify-8 "identify element" -body {
+    .tv configure -show {tree}
+    .tv insert branch  0 -id branch2 -open true
+    .tv insert branch2 0 -id branch3 -open true
+    .tv insert branch3 0 -id leaf3
+    update idletasks;
+    identify* .tv {item element} 10 10  30 30  50 50
+} -match glob -result [list \
+	branch $disclosure branch2 $disclosure branch3 $disclosure]
+
+# See #2381555 
+test treeview-identify-9 "identify works when horizontally scrolled" -setup {
+    .tv configure -show {tree headings}
+    foreach column {#0 A B C} {
+	.tv column $column -stretch 0 -width 50
+    }
+    place .tv -x 0 -y 0 -width 100
+} -body {
+    set result [list]
+    foreach xoffs {0 50 100} {
+	.tv xview $xoffs ; update
+	lappend result [identify* .tv {region column} 10 10 60 10]
+    }
+    set result
+} -result [list \
+	[list heading #0 heading #1] \
+	[list heading #1 heading #2] \
+	[list heading #2 heading #3] ]
+
+test treeview-identify-cleanup "identify - cleanup" -body {
+    destroy .tv
+}
+
+### NEED: tests for focus item, selection
 
 ### Misc. tests:
 
diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test
index a1430ff..9732f46 100644
--- a/tests/ttk/ttk.test
+++ b/tests/ttk/ttk.test
@@ -28,24 +28,19 @@ test ttk-6.2 "Checkbutton self-destructed" -body {
     winfo exists .sd
 } -result 0
 
-test ttk-6.3 "Test package cleanup" -body {
-    interp create foo
-    foo eval { if {[catch {package require Tk}]} { load {} Tk } }
-    foo eval { destroy . }
-    interp delete foo
-}
+# test ttk-6.3 not applicable [see #2175411]
 
-test ttk-6.4 "Defeat evil intentions" -body {
+test ttk-6.4 "Destroy widget in configure" -setup {
+    set OUCH ouch
     trace variable OUCH r { kill.b }
     proc kill.b {args} { destroy .b }
+} -cleanup {
+    unset OUCH
+} -body {
     pack [ttk::checkbutton .b]
-    .b configure -variable OUCH
-    # At this point, .b should be gone.
-    .b invoke
-    list [set OUCH] [winfo exists .b]
-    # Mostly we just care that we haven't crashed the interpreter.
-    #
-} -returnCodes error -match glob -result "*"
+    set rc [catch { .b configure -variable OUCH } msg]
+    list $rc $msg [winfo exists .b] [info commands .b]
+} -result [list 1 "Widget has been destroyed" 0 {}]
 
 test ttk-6.5 "Clean up -textvariable traces" -body {
     foreach class {ttk::button ttk::checkbutton ttk::radiobutton} {
@@ -66,7 +61,6 @@ test ttk-6.6 "Bad color spec in styles" -body {
     set ::bgerror
 } -result {unknown color name "badColor"}
 
-# This should move to be a standard test per widget test file
 test ttk-6.7 "Basic destruction test" -body {
     foreach widget {
 	button checkbutton radiobutton sizegrip separator notebook
@@ -85,9 +79,6 @@ test ttk-6.8 "Button command removes itself" -body {
     set ::A
 } -result {it worked}
 
-#
-#
-
 test ttk-6.9 "Bad font spec in styles" -setup {
     ttk::style theme create badfont -settings {
     	ttk::style configure . -font {Helvetica 12 Bogus}
@@ -103,10 +94,41 @@ test ttk-6.9 "Bad font spec in styles" -setup {
     set ::bgerror
 } -result {unknown font style "Bogus"}
 
+test ttk-construction-failure-1 "Excercise construction failure path" -setup {
+    option add *TLabel.cursor badCursor 1
+} -cleanup {
+    option add *TLabel.cursor {} 1
+} -body {
+    catch {ttk::label .l} errmsg
+    list $errmsg [info commands .l] [winfo exists .l]
+} -result [list {bad cursor spec "badCursor"} {} 0]
+
+test ttk-construction-failure-2 "Destroy widget in constructor" -setup {
+    set OUCH ouch
+    trace variable OUCH r { kill.b }
+    proc kill.b {args} { destroy .b }
+} -cleanup {
+    unset OUCH
+} -body {
+    list \
+	[catch { ttk::checkbutton .b -variable OUCH } msg] \
+	$msg \
+    	[winfo exists .b] \
+	[info commands .b] \
+	;
+} -result [list 1 "Widget has been destroyed" 0 {}]
+
+test ttk-selfdestruct-ok-1 "Intentional self-destruction" -body {
+    # see #2298720
+    toplevel .t
+    ttk::button .t.b -command [list destroy .t]
+    .t.b invoke
+    list [winfo exists .t] [winfo exists .t.b]
+} -result [list 0 0]
+
 #
 # Basic tests.
 #
-
 test ttk-1.1 "Create button" -body {
     pack [ttk::button .t] -expand true -fill both
     update
@@ -116,8 +138,11 @@ test ttk-1.2 "Check style" -body {
     .t cget -style
 } -result {}
 
+test ttk-1.3 "Set bad style" -body {
+    .t configure -style "nosuchstyle"
+} -returnCodes 1 -result {Layout nosuchstyle not found}
 
-test ttk-1.4 "Restore default style" -body {
+test ttk-1.4 "Original style preserved" -body {
     .t cget -style
 } -result ""
 
@@ -172,7 +197,6 @@ test ttk-2.7 "instate scripts, true" -body {
     set x
 } -result 1
 
-
 # misc. error detection
 test ttk-3.0 "Bad option" -body {
     ttk::button .bad -badoption foo
@@ -191,6 +215,10 @@ test ttk-3.2 "Propagate errors from variable traces" -body {
     unset ::A ; destroy .cb
 } -returnCodes error -result {can't set "A": failure}
 
+test ttk-3.3 "Constructor failure with cursor" -body {
+    ttk::button .b -cursor bottom_right_corner -style BadStyle
+} -returnCodes 1 -result "Layout BadStyle not found"
+
 test ttk-3.4 "SF#2009213" -body {
     ttk::style configure TScale -sliderrelief {}
     pack [ttk::scale .s]
@@ -241,90 +269,6 @@ test ttk-4.4 "Bad resource specifications" -body {
 }
 
 #
-# checkbutton tests
-#
-test ttk-5.1 "Checkbutton check" -body {
-    pack [ttk::checkbutton .cb -text "TCheckbutton" -variable cb]
-}
-test ttk-5.2 "Checkbutton invoke" -body {
-    .cb invoke
-    list [set ::cb] [.cb instate selected]
-} -result [list 1 1]
-test ttk-5.3 "Checkbutton reinvoke" -body {
-    .cb invoke
-    list [set ::cb] [.cb instate selected]
-} -result [list 0 0]
-
-test ttk-5.4 "Checkbutton variable" -body {
-    set result []
-    set ::cb 1
-    lappend result [.cb instate selected]
-    set ::cb 0
-    lappend result [.cb instate selected]
-} -result {1 0}
-
-test ttk-5.5 "Unset checkbutton variable" -body {
-    set result []
-    unset ::cb
-    lappend result [.cb instate alternate] [info exists ::cb]
-    set ::cb 1
-    lappend result [.cb instate alternate] [info exists ::cb]
-} -result {1 0 0 1}
-
-# See #1257319
-test ttk-5.6 "Checkbutton default variable" -body {
-    destroy .cb ; unset -nocomplain {} ; set result [list]
-    ttk::checkbutton .cb -onvalue on -offvalue off
-    lappend result [.cb cget -variable] [info exists .cb] [.cb state]
-    .cb invoke
-    lappend result [info exists .cb] [set .cb] [.cb state]
-    .cb invoke
-    lappend result [info exists .cb] [set .cb] [.cb state]
-} -result [list .cb 0 alternate   1 on selected  1 off {}]
-
-#
-# radiobutton tests
-#
-test ttk-7.1 "Radiobutton check" -body {
-    pack \
-    	[ttk::radiobutton .rb1 -text "One" -variable choice -value 1] \
-	[ttk::radiobutton .rb2 -text "Two" -variable choice -value 2] \
-	[ttk::radiobutton .rb3 -text "Three" -variable choice -value 3] \
-	;
-}
-test ttk-7.2 "Radiobutton invoke" -body {
-    .rb1 invoke
-    set ::choice
-} -result 1
-
-test ttk-7.3 "Radiobutton state" -body {
-    .rb1 instate selected
-} -result 1
-
-test ttk-7.4 "Other radiobutton invoke" -body {
-    .rb2 invoke
-    set ::choice
-} -result 2
-
-test ttk-7.5 "Other radiobutton state" -body {
-    .rb2 instate selected
-} -result 1
-
-test ttk-7.6 "First radiobutton state" -body {
-    .rb1 instate selected
-} -result 0
-
-test ttk-7.7 "Unset radiobutton variable" -body {
-    unset ::choice
-    list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate]
-} -result {0 1 1}
-
-test ttk-7.8 "Reset radiobutton variable" -body {
-    set ::choice 2
-    list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate]
-} -result {1 0 0}
-
-#
 # -compound tests:
 #
 variable iconData \
@@ -444,7 +388,7 @@ test ttk-9.6 "Unset -textvariable" -body {
 
 test ttk-9.7 "Unset textvariable, comparison" -body {
 #
-# NB: the ttk label behaves differently from the standard label here;
+# NB: ttk::label behaves differently from the standard label here;
 # NB: this is on purpose: I believe the standard behaviour is the Wrong Thing
 #
     unset -nocomplain V1  V2
@@ -554,7 +498,6 @@ test ttk-12.4 "-borderwidth frame option" -body {
     update
 }
 
-
 test ttk-13.1 "Custom styles -- bad -style option" -body {
     ttk::button .tb1 -style badstyle
 } -returnCodes 1 -result "*badstyle not found*" -match glob
@@ -596,16 +539,44 @@ test ttk-14.3 "-textvariable in nonexistant namespace" -body {
   -match glob -cleanup { destroy .tw }
 
 
-test ttk-15.1 "style element create: insufficient args" -body {
+## Test ensemble processing:
+#
+# (See also: SF#2021443)
+#
+proc wrong#args {args} {
+    return "wrong # args: should be \"$args\""
+}
+proc wrong#varargs {varpart args} {
+    set usage $args
+    append usage " ?$varpart ...?"
+    return "wrong # args: should be \"$usage\""
+}
+
+test ttk-ensemble-0 "style element create: insufficient args" -body {
+     ttk::style
+} -returnCodes 1 -result \
+    [wrong#varargs arg ttk::style option]
+
+test ttk-ensemble-1 "style element create: insufficient args" -body {
+     ttk::style element
+} -returnCodes 1 -result \
+    [wrong#varargs arg ttk::style element option]
+
+test ttk-ensemble-2 "style element create: insufficient args" -body {
      ttk::style element create
-} -returnCodes 1 -result "wrong # args: should be \"ttk::style element create name type ?options...?\""
-test ttk-15.2 "style element create: insufficient args" -body {
+} -returnCodes 1 -result \
+    [wrong#varargs {-option value} ttk::style element create name type]
+
+test ttk-ensemble-3 "style element create: insufficient args" -body {
      ttk::style element create plain.background
-} -returnCodes 1 -result "wrong # args: should be \"ttk::style element create name type ?options...?\""
-test ttk-15.3 "style element create: insufficient args" -body {
+} -returnCodes 1 -result \
+    [wrong#varargs {-option value} ttk::style element create name type]
+
+test ttk-ensemble-4 "style element create: insufficient args" -body {
      ttk::style element create plain.background from
-} -returnCodes 1 -result "wrong # args: should be \"theme ?element?\""
-test ttk-15.4 "style element create: valid" -body {
+} -returnCodes 1 -result [wrong#args theme ?element?]
+
+test ttk-ensemble-5 "style element create: valid" -body {
      ttk::style element create plain.background from default
 } -returnCodes 0 -result ""
 
diff --git a/tests/ttk/vsapi.test b/tests/ttk/vsapi.test
index 7000e3e..21898bb 100644
--- a/tests/ttk/vsapi.test
+++ b/tests/ttk/vsapi.test
@@ -1,5 +1,5 @@
 # -*- tcl -*-
-# $Id: vsapi.test,v 1.1.2.2 2009/05/14 00:53:04 patthoyts Exp $
+# $Id: vsapi.test,v 1.1.2.3 2010/08/26 02:06:10 hobbs Exp $
 #
 
 package require Tk 8.5