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

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