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

   1 #
   2 # Bindings for Menubuttons.
   3 #
   4 # Menubuttons have three interaction modes:
   5 #
   6 # Pulldown: Press menubutton, drag over menu, release to activate menu entry
   7 # Popdown: Click menubutton to post menu
   8 # Keyboard: <Key-space> or accelerator key to post menu
   9 #
  10 # (In addition, when menu system is active, "dropdown" -- menu posts
  11 # on mouse-over.  Ttk menubuttons don't implement this).
  12 #
  13 # For keyboard and popdown mode, we hand off to tk_popup and let
  14 # the built-in Tk bindings handle the rest of the interaction.
  15 #
  16 # ON X11:
  17 #
  18 # Standard Tk menubuttons use a global grab on the menubutton.
  19 # This won't work for Ttk menubuttons in pulldown mode,
  20 # since we need to process the final <ButtonRelease> event,
  21 # and this might be delivered to the menu.  So instead we
  22 # rely on the passive grab that occurs on <ButtonPress> events,
  23 # and transition to popdown mode when the mouse is released
  24 # or dragged outside the menubutton.
  25 #
  26 # ON WINDOWS:
  27 #
  28 # I'm not sure what the hell is going on here.  [$menu post] apparently
  29 # sets up some kind of internal grab for native menus.
  30 # On this platform, just use [tk_popup] for all menu actions.
  31 #
  32 # ON MACOS:
  33 #
  34 # Same probably applies here.
  35 #
  36
  37 namespace eval ttk {
  38     namespace eval menubutton {
  39         variable State
  40         array set State {
  41             pulldown    0
  42             oldcursor   {}
  43         }
  44     }
  45 }
  46
  47 bind TMenubutton <Enter>        { %W instate !disabled {%W state active } }
  48 bind TMenubutton <Leave>        { %W state !active }
  49 bind TMenubutton <Key-space>    { ttk::menubutton::Popdown %W }
  50 bind TMenubutton <<Invoke>>     { ttk::menubutton::Popdown %W }
  51
  52 if {[tk windowingsystem] eq "x11"} {
  53     bind TMenubutton <ButtonPress-1>    { ttk::menubutton::Pulldown %W }
  54     bind TMenubutton <ButtonRelease-1>  { ttk::menubutton::TransferGrab %W }
  55     bind TMenubutton <B1-Leave>         { ttk::menubutton::TransferGrab %W }
  56 } else {
  57     bind TMenubutton <ButtonPress-1>  \
  58         { %W state pressed ; ttk::menubutton::Popdown %W }
  59     bind TMenubutton <ButtonRelease-1>  \
  60         { %W state !pressed }
  61 }
  62
  63 # PostPosition --
  64 #       Returns the x and y coordinates where the menu
  65 #       should be posted, based on the menubutton and menu size
  66 #       and -direction option.
  67 #
  68 # TODO: adjust menu width to be at least as wide as the button
  69 #       for -direction above, below.
  70 #
  71 proc ttk::menubutton::PostPosition {mb menu} {
  72     set x [winfo rootx $mb]
  73     set y [winfo rooty $mb]
  74     set dir [$mb cget -direction]
  75
  76     set bw [winfo width $mb]
  77     set bh [winfo height $mb]
  78     set mw [winfo reqwidth $menu]
  79     set mh [winfo reqheight $menu]
  80     set sw [expr {[winfo screenwidth  $menu] - $bw - $mw}]
  81     set sh [expr {[winfo screenheight $menu] - $bh - $mh}]
  82
  83     switch -- $dir {
  84         above { if {$y >= $mh} { incr y -$mh } { incr y  $bh } }
  85         below { if {$y <= $sh} { incr y  $bh } { incr y -$mh } }
  86         left  { if {$x >= $mw} { incr x -$mw } { incr x  $bw } }
  87         right { if {$x <= $sw} { incr x  $bw } { incr x -$mw } }
  88         flush {
  89             # post menu atop menubutton.
  90             # If there's a menu entry whose label matches the
  91             # menubutton -text, assume this is an optionmenu
  92             # and place that entry over the menubutton.
  93             set index [FindMenuEntry $menu [$mb cget -text]]
  94             if {$index ne ""} {
  95                 incr y -[$menu yposition $index]
  96             }
  97         }
  98     }
  99
 100     return [list $x $y]
 101 }
 102
 103 # Popdown --
 104 #       Post the menu and set a grab on the menu.
 105 #
 106 proc ttk::menubutton::Popdown {mb} {
 107     if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
 108         return
 109     }
 110     foreach {x y} [PostPosition $mb $menu] { break }
 111     tk_popup $menu $x $y
 112 }
 113
 114 # Pulldown (X11 only) --
 115 #       Called when Button1 is pressed on a menubutton.
 116 #       Posts the menu; a subsequent ButtonRelease
 117 #       or Leave event will set a grab on the menu.
 118 #
 119 proc ttk::menubutton::Pulldown {mb} {
 120     variable State
 121     if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
 122         return
 123     }
 124     foreach {x y} [PostPosition $mb $menu] { break }
 125     set State(pulldown) 1
 126     set State(oldcursor) [$mb cget -cursor]
 127
 128     $mb state pressed
 129     $mb configure -cursor [$menu cget -cursor]
 130     $menu post $x $y
 131     tk_menuSetFocus $menu
 132 }
 133
 134 # TransferGrab (X11 only) --
 135 #       Switch from pulldown mode (menubutton has an implicit grab)
 136 #       to popdown mode (menu has an explicit grab).
 137 #
 138 proc ttk::menubutton::TransferGrab {mb} {
 139     variable State
 140     if {$State(pulldown)} {
 141         $mb configure -cursor $State(oldcursor)
 142         $mb state {!pressed !active}
 143         set State(pulldown) 0
 144
 145         set menu [$mb cget -menu]
 146         tk_popup $menu [winfo rootx $menu] [winfo rooty $menu]
 147     }
 148 }
 149
 150 # FindMenuEntry --
 151 #       Hack to support tk_optionMenus.
 152 #       Returns the index of the menu entry with a matching -label,
 153 #       -1 if not found.
 154 #
 155 proc ttk::menubutton::FindMenuEntry {menu s} {
 156     set last [$menu index last]
 157     if {$last eq "none"} {
 158         return ""
 159     }
 160     for {set i 0} {$i <= $last} {incr i} {
 161         if {![catch {$menu entrycget $i -label} label]
 162             && ($label eq $s)} {
 163             return $i
 164         }
 165     }
 166     return ""
 167 }
 168
 169 #*EOF*