# # $Id: button.tcl,v 1.2.4.1 2010/08/26 02:06:10 hobbs Exp $ # # Bindings for Buttons, Checkbuttons, and Radiobuttons. # # Notes: , only control the "pressed" # state; widgets remain "active" if the pointer is dragged out. # This doesn't seem to be conventional, but it's a nice way # to provide extra feedback while the grab is active. # (If the button is released off the widget, the grab deactivates and # we get a event then, which turns off the "active" state) # # Normally, and events are # delivered to the widget which received the initial # event. However, Tk [grab]s (#1223103) and menu interactions # (#1222605) can interfere with this. To guard against spurious # events, the binding only sets # the pressed state if the button is currently active. # namespace eval ttk::button {} bind TButton { %W instate !disabled {%W state active} } bind TButton { %W state !active } bind TButton { ttk::button::activate %W } bind TButton <> { ttk::button::activate %W } bind TButton \ { %W instate !disabled { ttk::clickToFocus %W; %W state pressed } } bind TButton \ { %W instate pressed { %W state !pressed; %W instate !disabled { %W invoke } } } bind TButton \ { %W state !pressed } bind TButton \ { %W instate {active !disabled} { %W state pressed } } # Checkbuttons and Radiobuttons have the same bindings as Buttons: # ttk::copyBindings TButton TCheckbutton ttk::copyBindings TButton TRadiobutton # ...plus a few more: bind TRadiobutton { ttk::button::RadioTraverse %W -1 } bind TRadiobutton { ttk::button::RadioTraverse %W +1 } # bind TCheckbutton { %W select } # bind TCheckbutton { %W deselect } # activate -- # Simulate a button press: temporarily set the state to 'pressed', # then invoke the button. # proc ttk::button::activate {w} { $w instate disabled { return } set oldState [$w state pressed] update idletasks; after 100 ;# block event loop to avoid reentrancy $w state $oldState $w invoke } # RadioTraverse -- up/down keyboard traversal for radiobutton groups. # Set focus to previous/next radiobutton in a group. # A radiobutton group consists of all the radiobuttons with # the same parent and -variable; this is a pretty good heuristic # that works most of the time. # proc ttk::button::RadioTraverse {w dir} { set group [list] foreach sibling [winfo children [winfo parent $w]] { if { [winfo class $sibling] eq "TRadiobutton" && [$sibling cget -variable] eq [$w cget -variable] && ![$sibling instate disabled] } { lappend group $sibling } } if {![llength $group]} { # Shouldn't happen, but can. return } set pos [expr {([lsearch -exact $group $w] + $dir) % [llength $group]}] tk::TabToWindow [lindex $group $pos] }