button.tcl 2.9 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283
  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 <Button>
  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. namespace eval ttk::button {}
  19. bind TButton <Enter> { %W instate !disabled {%W state active} }
  20. bind TButton <Leave> { %W state !active }
  21. bind TButton <space> { ttk::button::activate %W }
  22. bind TButton <<Invoke>> { ttk::button::activate %W }
  23. bind TButton <Button-1> \
  24. { %W instate !disabled { ttk::clickToFocus %W; %W state pressed } }
  25. bind TButton <ButtonRelease-1> \
  26. { %W instate pressed { %W state !pressed; %W instate !disabled { %W invoke } } }
  27. bind TButton <Button1-Leave> \
  28. { %W state !pressed }
  29. bind TButton <Button1-Enter> \
  30. { %W instate {active !disabled} { %W state pressed } }
  31. # Checkbuttons and Radiobuttons have the same bindings as Buttons:
  32. #
  33. ttk::copyBindings TButton TCheckbutton
  34. ttk::copyBindings TButton TRadiobutton
  35. # ...plus a few more:
  36. bind TRadiobutton <Up> { ttk::button::RadioTraverse %W -1 }
  37. bind TRadiobutton <Down> { ttk::button::RadioTraverse %W +1 }
  38. # bind TCheckbutton <plus> { %W select }
  39. # bind TCheckbutton <minus> { %W deselect }
  40. # activate --
  41. # Simulate a button press: temporarily set the state to 'pressed',
  42. # then invoke the button.
  43. #
  44. proc ttk::button::activate {w} {
  45. $w instate disabled { return }
  46. set oldState [$w state pressed]
  47. update idletasks; after 100 ;# block event loop to avoid reentrancy
  48. $w state $oldState
  49. $w invoke
  50. }
  51. # RadioTraverse -- up/down keyboard traversal for radiobutton groups.
  52. # Set focus to previous/next radiobutton in a group.
  53. # A radiobutton group consists of all the radiobuttons with
  54. # the same parent and -variable; this is a pretty good heuristic
  55. # that works most of the time.
  56. #
  57. proc ttk::button::RadioTraverse {w dir} {
  58. set group [list]
  59. foreach sibling [winfo children [winfo parent $w]] {
  60. if { [winfo class $sibling] eq "TRadiobutton"
  61. && [$sibling cget -variable] eq [$w cget -variable]
  62. && ![$sibling instate disabled]
  63. } {
  64. lappend group $sibling
  65. }
  66. }
  67. if {![llength $group]} { # Shouldn't happen, but can.
  68. return
  69. }
  70. set pos [expr {([lsearch -exact $group $w] + $dir) % [llength $group]}]
  71. tk::TabToWindow [lindex $group $pos]
  72. }