venv/tcl/tk8.6/ttk/button.tcl

   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 }