From 3b0766a0c0ae34bf03ac660bb06d9c35fb8eb1b7 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 28 Jan 2024 08:55:18 +0000 Subject: [PATCH 1/3] 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 1ef48c57c1..6a700b5fb1 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 9c82cd7941..4a22dfc057 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 From c3b21bba760c1c47f0ac5c7a139b21e4980e8058 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 28 Jan 2024 09:03:07 +0000 Subject: [PATCH 2/3] 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 e16fba4014..5cb5ab912d 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]] From 94c43af238aa6f3e2ab28e490fb979a079befc41 Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 28 Jan 2024 09:26:06 +0000 Subject: [PATCH 3/3] 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 4d3874f08a..a9938cdb7d 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]]