mingw/lib/tk8.5/ttk/button.tcl

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