From 3b0766a0c0ae34bf03ac660bb06d9c35fb8eb1b7 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 28 Jan 2024 08:55:18 +0000 Subject: Add tests demonstrating bug [9fa3e08243]: Ctrl-Arrow binding for spinbox: unknown option '-show'. For Tk, spinbox-25.3 fails (as expected). For Ttk, spinbox-11.2 does not fail because the ttk::spinbox inherits the -show option of the ttk::entry widget, event though it's not used nor documented for ttk::spinbox. (Note: tests numbering mirror their counterparts in entry.test). --- tests/spinbox.test | 20 ++++++++++++++++++++ tests/ttk/spinbox.test | 21 +++++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/tests/spinbox.test b/tests/spinbox.test index 1ef48c5..6a700b5 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -3873,6 +3873,26 @@ test spinbox-25.1 {textvariable lives in a non-existing namespace} -setup { } -cleanup { destroy .s } -result {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} +test spinbox-25.3 {Bugs [2a32225cd1] and [9fa3e08243]} -setup { + destroy .s + pack [spinbox .s] + update + set res {} +} -body { + .s insert end "A sample text" + .s icursor end + event generate .s <> ; # shall move insert to index 9 + .s delete insert end + lappend res [.s get] + .s delete 0 end + .s insert end "A sample text" + .s icursor 2 + event generate .s <> ; # shall move insert to index 9 + .s delete 0 insert + lappend res [.s get] +} -cleanup { + destroy .s +} -result {{A sample } text} # Collected comments about lacks from the test # XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc, diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test index 9c82cd7..4a22dfc 100644 --- a/tests/ttk/spinbox.test +++ b/tests/ttk/spinbox.test @@ -287,6 +287,27 @@ test spinbox-4.2 "Increment with duplicates in -values, no wrap" -setup { unset -nocomplain ::spinbox_test max } -result {one two three 4 5 two six six six two 5 4 three two one one one one} +test spinbox-11.2 {Bugs [2a32225cd1] and [9fa3e08243]} -setup { + destroy .s + pack [ttk::spinbox .s] + update + set res {} +} -body { + .s insert end "A sample text" + .s icursor end + event generate .s <> ; # shall move insert to index 9 + .s delete insert end + lappend res [.s get] + .s delete 0 end + .s insert end "A sample text" + .s icursor 2 + event generate .s <> ; # shall move insert to index 9 + .s delete 0 insert + lappend res [.s get] +} -cleanup { + destroy .s +} -result {{A sample } text} + # nostomp: NB intentional difference between ttk::spinbox and tk::spinbox; # see also #1439266 -- cgit v0.12 From c3b21bba760c1c47f0ac5c7a139b21e4980e8058 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 28 Jan 2024 09:03:07 +0000 Subject: Fix [9fa3e08243]: Ctrl-Arrow binding for spinbox: unknown option '-show'. --- library/entry.tcl | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index e16fba4..5cb5ab9 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -599,7 +599,8 @@ proc ::tk::EntryTranspose w { if {[tk windowingsystem] eq "win32"} { proc ::tk::EntryNextWord {w start} { - if {[$w cget -show] ne ""} { + # the check on [winfo class] is because the spinbox also uses this proc + if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} { return end } set pos [tcl_endOfWord [$w get] [$w index $start]] @@ -613,7 +614,8 @@ if {[tk windowingsystem] eq "win32"} { } } else { proc ::tk::EntryNextWord {w start} { - if {[$w cget -show] ne ""} { + # the check on [winfo class] is because the spinbox also uses this proc + if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} { return end } set pos [tcl_endOfWord [$w get] [$w index $start]] @@ -634,7 +636,8 @@ if {[tk windowingsystem] eq "win32"} { # start - Position at which to start search. proc ::tk::EntryPreviousWord {w start} { - if {[$w cget -show] ne ""} { + # the check on [winfo class] is because the spinbox also uses this proc + if {[winfo class $w] eq "Entry" && [$w cget -show] ne ""} { return 0 } set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] -- cgit v0.12 From 94c43af238aa6f3e2ab28e490fb979a079befc41 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 28 Jan 2024 09:26:06 +0000 Subject: Do the same for ttk::spinbox and ttk::combobox. This is not absolutely needed: there is no error triggering on <>/<> because these widgets inherit the -show option from ttk::entry even if it does not really make sense for these types of widget. However it's better to do it for those widgets so that the behavior is consistent with Tk widgets, and in case people use -show with ttk::spinbox/combobox they would not be able to identify the words in the widget (see [2a32225cd1]). --- library/ttk/entry.tcl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 4d3874f..a9938cd 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -254,7 +254,8 @@ set ::ttk::entry::State(startNext) \ [string equal [tk windowingsystem] "win32"] proc ttk::entry::NextWord {w start} { - if {[$w cget -show] ne ""} { + # the check on [winfo class] is because the spinbox and combobox also use this proc + if {[winfo class $w] eq "TEntry" && [$w cget -show] ne ""} { return end } variable State @@ -271,7 +272,8 @@ proc ttk::entry::NextWord {w start} { ## PrevWord -- Find the previous word position. # proc ttk::entry::PrevWord {w start} { - if {[$w cget -show] ne ""} { + # the check on [winfo class] is because the spinbox and combobox also use this proc + if {[winfo class $w] eq "TEntry" && [$w cget -show] ne ""} { return 0 } set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] -- cgit v0.12