button.tcl (2978B)
1 # 2 # Bindings for Buttons, Checkbuttons, and Radiobuttons. 3 # 4 # Notes: <Button1-Leave>, <Button1-Enter> only control the "pressed" 5 # state; widgets remain "active" if the pointer is dragged out. 6 # This doesn't seem to be conventional, but it's a nice way 7 # to provide extra feedback while the grab is active. 8 # (If the button is released off the widget, the grab deactivates and 9 # we get a <Leave> event then, which turns off the "active" state) 10 # 11 # Normally, <ButtonRelease> and <ButtonN-Enter/Leave> events are 12 # delivered to the widget which received the initial <ButtonPress> 13 # event. However, Tk [grab]s (#1223103) and menu interactions 14 # (#1222605) can interfere with this. To guard against spurious 15 # <Button1-Enter> events, the <Button1-Enter> binding only sets 16 # the pressed state if the button is currently active. 17 # 18 19 namespace eval ttk::button {} 20 21 bind TButton <Enter> { %W instate !disabled {%W state active} } 22 bind TButton <Leave> { %W state !active } 23 bind TButton <Key-space> { ttk::button::activate %W } 24 bind TButton <<Invoke>> { ttk::button::activate %W } 25 26 bind TButton <ButtonPress-1> \ 27 { %W instate !disabled { ttk::clickToFocus %W; %W state pressed } } 28 bind TButton <ButtonRelease-1> \ 29 { %W instate pressed { %W state !pressed; %W instate !disabled { %W invoke } } } 30 bind TButton <Button1-Leave> \ 31 { %W state !pressed } 32 bind TButton <Button1-Enter> \ 33 { %W instate {active !disabled} { %W state pressed } } 34 35 # Checkbuttons and Radiobuttons have the same bindings as Buttons: 36 # 37 ttk::copyBindings TButton TCheckbutton 38 ttk::copyBindings TButton TRadiobutton 39 40 # ...plus a few more: 41 42 bind TRadiobutton <KeyPress-Up> { ttk::button::RadioTraverse %W -1 } 43 bind TRadiobutton <KeyPress-Down> { ttk::button::RadioTraverse %W +1 } 44 45 # bind TCheckbutton <KeyPress-plus> { %W select } 46 # bind TCheckbutton <KeyPress-minus> { %W deselect } 47 48 # activate -- 49 # Simulate a button press: temporarily set the state to 'pressed', 50 # then invoke the button. 51 # 52 proc ttk::button::activate {w} { 53 $w instate disabled { return } 54 set oldState [$w state pressed] 55 update idletasks; after 100 ;# block event loop to avoid reentrancy 56 $w state $oldState 57 $w invoke 58 } 59 60 # RadioTraverse -- up/down keyboard traversal for radiobutton groups. 61 # Set focus to previous/next radiobutton in a group. 62 # A radiobutton group consists of all the radiobuttons with 63 # the same parent and -variable; this is a pretty good heuristic 64 # that works most of the time. 65 # 66 proc ttk::button::RadioTraverse {w dir} { 67 set group [list] 68 foreach sibling [winfo children [winfo parent $w]] { 69 if { [winfo class $sibling] eq "TRadiobutton" 70 && [$sibling cget -variable] eq [$w cget -variable] 71 && ![$sibling instate disabled] 72 } { 73 lappend group $sibling 74 } 75 } 76 77 if {![llength $group]} { # Shouldn't happen, but can. 78 return 79 } 80 81 set pos [expr {([lsearch -exact $group $w] + $dir) % [llength $group]}] 82 tk::TabToWindow [lindex $group $pos] 83 }