Merge 8.7

13 files changed, 224 insertions, 32 deletions

diff --git a/tests/ttk/checkbutton.test b/tests/ttk/checkbutton.test
index 9c58a7b..248db96 100644
--- a/tests/ttk/checkbutton.test
+++ b/tests/ttk/checkbutton.test
@@ -71,4 +71,18 @@ test checkbutton-1.8 "Empty -variable" -body {
     destroy .cbev
 } -result {}
 
+test checkbutton-2.1 "style command" -body {
+    ttk::checkbutton .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} TCheckbutton TCheckbutton}
+test checkbutton-2.2 "style command" -body {
+    ttk::style configure customStyle.TCheckbutton
+    ttk::checkbutton .w -style customStyle.TCheckbutton
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TCheckbutton customStyle.TCheckbutton TCheckbutton}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/combobox.test b/tests/ttk/combobox.test
index dd1a7f9..a5627d2 100644
--- a/tests/ttk/combobox.test
+++ b/tests/ttk/combobox.test
@@ -86,4 +86,18 @@ test combobox-1890211 "ComboboxSelected event after listbox unposted" -body {
     destroy .cb
 }
 
+test combobox-4.1 "style command" -body {
+    ttk::combobox .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} TCombobox TCombobox}
+test combobox-4.2 "style command" -body {
+    ttk::style configure customStyle.TCombobox
+    ttk::combobox .w -style customStyle.TCombobox
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TCombobox customStyle.TCombobox TCombobox}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test
index 7e3fe88..824cb6a 100644
--- a/tests/ttk/entry.test
+++ b/tests/ttk/entry.test
@@ -369,4 +369,18 @@ test entry-11.1 {Bug [2830360fff] - Don't loose invalid at focus events} -setup
     destroy .e
 }
 
+test entry-12.1 "style command" -body {
+    ttk::entry .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} TEntry TEntry}
+test entry-12.2 "style command" -body {
+    ttk::style configure customStyle.TEntry
+    ttk::entry .w -style customStyle.TEntry
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TEntry customStyle.TEntry TEntry}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/labelframe.test b/tests/ttk/labelframe.test
index 3bbf584..d81d33d 100644
--- a/tests/ttk/labelframe.test
+++ b/tests/ttk/labelframe.test
@@ -128,4 +128,18 @@ test labelframe-6.1 "Stacking order" -body {
     destroy .t
 } -result [list .t.x1 .t.lf .t.lb .t.x2]
 
+test labelframe-7.1 "style command" -body {
+    ttk::labelframe .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} TLabelframe TLabelframe}
+test labelframe-7.2 "style command" -body {
+    ttk::style configure customStyle.TLabelframe
+    ttk::labelframe .w -style customStyle.TLabelframe
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TLabelframe customStyle.TLabelframe TLabelframe}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test
index 50047cf..8c2e186 100644
--- a/tests/ttk/notebook.test
+++ b/tests/ttk/notebook.test
@@ -512,4 +512,18 @@ test notebook-1343984-2 "don't autoselect on destroy" -body {
     set ::history
 } -result [list DESTROY .nb.frame1 DESTROY .nb.frame2 DESTROY .nb.frame3]
 
+test notebook-8.1 "style command" -body {
+    ttk::notebook .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} TNotebook TNotebook}
+test notebook-8.2 "style command" -body {
+    ttk::style configure customStyle.TNotebook
+    ttk::notebook .w -style customStyle.TNotebook
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TNotebook customStyle.TNotebook TNotebook}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/panedwindow.test b/tests/ttk/panedwindow.test
index e45a3a9..d9909c0 100644
--- a/tests/ttk/panedwindow.test
+++ b/tests/ttk/panedwindow.test
@@ -289,4 +289,22 @@ test paned-propagation-5 "Pane change after map, on-axis" -body {
 
 test paned-propagation-cleanup "Clean up." -body { destroy .pw }
 
+test panedwindow-6.1 "style command" -body {
+    # Contrary to ttk::scrollbar, ttk::progressbar and ttk::scale,
+    # ttk::panedwindow has same style TPanedwindow whatever -orient is
+    ttk::panedwindow .wv  ; # default is  -orient vertical
+    ttk::panedwindow .wh -orient horizontal
+    list [.wv cget -style] [.wv style] [winfo class .wv]\
+         [.wh cget -style] [.wh style] [winfo class .wh]
+} -cleanup {
+    destroy .wv .wh
+} -result {{} TPanedwindow TPanedwindow {} TPanedwindow TPanedwindow}
+test panedwindow-6.2 "style command" -body {
+    ttk::style configure customStyle.TPanedwindow
+    ttk::panedwindow .w -style customStyle.TPanedwindow
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TPanedwindow customStyle.TPanedwindow TPanedwindow}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/progressbar.test b/tests/ttk/progressbar.test
index ac8bbf1..80e51ea 100644
--- a/tests/ttk/progressbar.test
+++ b/tests/ttk/progressbar.test
@@ -122,4 +122,20 @@ test progressbar-3.2 "TIP #442 options are taken into account" -setup {
     destroy .p
 } -result {{-anchor e} {-foreground green} {-justify center} {-text {Cannot be seen}} {-wraplength 250}}
 
+test progressbar-4.1 "style command" -body {
+    ttk::progressbar .wh  ; # default is  -orient horizontal
+    ttk::progressbar .wv -orient vertical
+    list [.wh cget -style] [.wh style] [winfo class .wh]\
+         [.wv cget -style] [.wv style] [winfo class .wv]
+} -cleanup {
+    destroy .wh .wv
+} -result {{} Horizontal.TProgressbar TProgressbar {} Vertical.TProgressbar TProgressbar}
+test progressbar-4.2 "style command" -body {
+    ttk::style configure customStyle.Vertical.TProgressbar
+    ttk::progressbar .w -orient vertical -style customStyle.Vertical.TProgressbar
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.Vertical.TProgressbar Vertical.customStyle.Vertical.TProgressbar TProgressbar}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/radiobutton.test b/tests/ttk/radiobutton.test
index 9140805..6de5b5e 100644
--- a/tests/ttk/radiobutton.test
+++ b/tests/ttk/radiobutton.test
@@ -46,4 +46,18 @@ test radiobutton-1.8 "Reset radiobutton variable" -body {
     list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate]
 } -result {1 0 0}
 
+test radiobutton-2.1 "style command" -body {
+    ttk::radiobutton .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} TRadiobutton TRadiobutton}
+test radiobutton-2.2 "style command" -body {
+    ttk::style configure customStyle.TRadiobutton
+    ttk::radiobutton .w -style customStyle.TRadiobutton
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TRadiobutton customStyle.TRadiobutton TRadiobutton}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/scale.test b/tests/ttk/scale.test
new file mode 100644
index 0000000..ddbb7b3
--- /dev/null
+++ b/tests/ttk/scale.test
@@ -0,0 +1,53 @@
+package require Tk
+package require tcltest 2.2
+namespace import -force tcltest::*
+loadTestedCommands
+
+test scale-1.0 "Self-destruction" -body {
+    trace variable v w { destroy .s ;# }
+    ttk::scale .s -variable v
+    pack .s ; update
+    .s set 1 ; update
+} -returnCodes error -match glob -result "*"
+
+test scale-2.1 "-state option" -setup {
+    ttk::scale .s
+    set res ""
+} -body {
+    # defaults
+    lappend res [.s instate disabled] [.s cget -state]
+    # set -state: instate returns accordingly
+    .s configure -state disabled
+    lappend res [.s instate disabled] [.s cget -state]
+    # back to normal
+    .s configure -state normal
+    lappend res [.s instate disabled] [.s cget -state]
+    # use state command: -state does NOT reflect it
+    .s state disabled
+    lappend res [.s instate disabled] [.s cget -state]
+    # further use state command
+    .s state readonly
+    lappend res [.s state] [.s cget -state]
+} -cleanup {
+    destroy .s
+    unset -nocomplain res
+} -result {0 normal 1 disabled 0 normal 1 normal {disabled readonly} normal}
+
+test scale-3.1 "style command" -body {
+    ttk::scale .wh  ; # default is  -orient horizontal
+    ttk::scale .wv -orient vertical
+    list [.wh cget -style] [.wh style] [winfo class .wh] \
+         [.wv cget -style] [.wv style] [winfo class .wv]
+} -cleanup {
+    destroy .wh .wv
+} -result {{} Horizontal.TScale TScale {} Vertical.TScale TScale}
+test scale-3.2 "style command" -body {
+    ttk::style configure customStyle.Vertical.TScale
+    ttk::scale .w -orient vertical -style customStyle.Vertical.TScale
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.Vertical.TScale Vertical.customStyle.Vertical.TScale TScale}
+
+tcltest::cleanupTests
+
diff --git a/tests/ttk/scrollbar.test b/tests/ttk/scrollbar.test
index 1ee63a3..e4b2959 100644
--- a/tests/ttk/scrollbar.test
+++ b/tests/ttk/scrollbar.test
@@ -115,39 +115,21 @@ test scrollbar-10.2.2 {<MouseWheel> event on horizontal scrollbar} -setup {
     destroy .t .s
 } -result {1.4}
 
-#
-# Scale tests:
-#
-
-test scale-1.0 "Self-destruction" -body {
-    trace variable v w { destroy .s ;# }
-    ttk::scale .s -variable v
-    pack .s ; update
-    .s set 1 ; update
-} -returnCodes error -match glob -result "*"
-
-test scale-2.1 "-state option" -setup {
-    ttk::scale .s
-    set res ""
-} -body {
-    # defaults
-    lappend res [.s instate disabled] [.s cget -state]
-    # set -state: instate returns accordingly
-    .s configure -state disabled
-    lappend res [.s instate disabled] [.s cget -state]
-    # back to normal
-    .s configure -state normal
-    lappend res [.s instate disabled] [.s cget -state]
-    # use state command: -state does NOT reflect it
-    .s state disabled
-    lappend res [.s instate disabled] [.s cget -state]
-    # further use state command
-    .s state readonly
-    lappend res [.s state] [.s cget -state]
+test scrollbar-11.1 "style command" -body {
+    ttk::scrollbar .wv  ; # default is  -orient vertical
+    ttk::scrollbar .wh -orient horizontal
+    list [.wv cget -style] [.wv style] [winfo class .wv] \
+         [.wh cget -style] [.wh style] [winfo class .wh]
+} -cleanup {
+    destroy .wv .wh
+} -result {{} Vertical.TScrollbar TScrollbar {} Horizontal.TScrollbar TScrollbar}
+test scrollbar-11.2 "style command" -body {
+    ttk::style configure customStyle.Horizontal.TScrollbar
+    ttk::scrollbar .w -orient horizontal -style customStyle.Horizontal.TScrollbar
+    list [.w cget -style] [.w style] [winfo class .w]
 } -cleanup {
-    destroy .s
-    unset -nocomplain res
-} -result {0 normal 1 disabled 0 normal 1 normal {disabled readonly} normal}
+    destroy .w
+} -result {customStyle.Horizontal.TScrollbar Horizontal.customStyle.Horizontal.TScrollbar TScrollbar}
 
 tcltest::cleanupTests
 
diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test
index a2b8558..abd2a0f 100644
--- a/tests/ttk/spinbox.test
+++ b/tests/ttk/spinbox.test
@@ -358,6 +358,20 @@ test spinbox-dieoctaldie-2 "Cope with general bad input" -body {
     destroy .sb
 }
 
+test spinbox-5.1 "style command" -body {
+    ttk::spinbox .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} TSpinbox TSpinbox}
+test spinbox-5.2 "style command" -body {
+    ttk::style configure customStyle.TSpinbox
+    ttk::spinbox .w -style customStyle.TSpinbox
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.TSpinbox customStyle.TSpinbox TSpinbox}
+
 tcltest::cleanupTests
 
 # Local variables:
diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test
index 3000d95..3d186e1 100644
--- a/tests/ttk/treeview.test
+++ b/tests/ttk/treeview.test
@@ -835,4 +835,18 @@ test treeview-ce470f20fd-4 "changing -stretch resizes columns" -setup {
     destroy .tv
 } -result {60 50 60 50 60 50 1}
 
+test treeview-11.1 "style command" -body {
+    ttk::treeview .w
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {{} Treeview Treeview}
+test treeview-11.2 "style command" -body {
+    ttk::style configure customStyle.Treeview
+    ttk::treeview .w -style customStyle.Treeview
+    list [.w cget -style] [.w style] [winfo class .w]
+} -cleanup {
+    destroy .w
+} -result {customStyle.Treeview customStyle.Treeview Treeview}
+
 tcltest::cleanupTests
diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test
index dee3179..e8093a9 100644
--- a/tests/ttk/ttk.test
+++ b/tests/ttk/ttk.test
@@ -655,6 +655,17 @@ test ttk-ensemble-5 "style element create: valid" -body {
      ttk::style element create plain.background from default
 } -returnCodes 0 -result ""
 
+test ttk-16.1 {ttk::style theme styles - no such theme} -body {
+    ttk::style theme styles noSuchTheme
+} -returnCodes 1 -result {theme "noSuchTheme" doesn't exist}
+test ttk-16.2 {ttk::style theme styles - theme exists} -body {
+    # simply check this produces a list with some style names,
+    # without checking exact content (not needed, and may vary
+    # depending on platform, versions, improvements...)
+    expr {[llength [ttk::style theme styles alt]] > 0}
+} -result 1
+
+
 eval destroy [winfo children .]
 
 tcltest::cleanupTests