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

   1 #
   2 # $Id: utils.tcl,v 1.6 2008/01/06 19:16:12 jenglish Exp $
   3 #
   4 # Utilities for widget implementations.
   5 #
   6
   7 ### Focus management.
   8 #
   9
  10 ## ttk::takefocus --
  11 #       This is the default value of the "-takefocus" option
  12 #       for widgets that participate in keyboard navigation.
  13 #
  14 # See also: tk::FocusOK
  15 #
  16 proc ttk::takefocus {w} {
  17     expr {[$w instate !disabled] && [winfo viewable $w]}
  18 }
  19
  20 ## ttk::traverseTo $w --
  21 #       Set the keyboard focus to the specified window.
  22 #
  23 proc ttk::traverseTo {w} {
  24     set focus [focus]
  25     if {$focus ne ""} {
  26         event generate $focus <<TraverseOut>>
  27     }
  28     focus $w
  29     event generate $w <<TraverseIn>>
  30 }
  31
  32 ## ttk::clickToFocus $w --
  33 #       Utility routine, used in <ButtonPress-1> bindings --
  34 #       Assign keyboard focus to the specified widget if -takefocus is enabled.
  35 #
  36 proc ttk::clickToFocus {w} {
  37     if {[ttk::takesFocus $w]} { focus $w }
  38 }
  39
  40 ## ttk::takesFocus w --
  41 #       Test if the widget can take keyboard focus:
  42 #
  43 #       + widget is viewable, AND:
  44 #       - if -takefocus is missing or empty, return 0, OR
  45 #       - if -takefocus is 0 or 1, return that value, OR
  46 #       - append the widget name to -takefocus and evaluate it
  47 #         as a script.
  48 #
  49 # See also: tk::FocusOK
  50 #
  51 # Note: This routine doesn't implement the same fallback heuristics
  52 #       as tk::FocusOK.
  53 #
  54 proc ttk::takesFocus {w} {
  55
  56     if {![winfo viewable $w]} { return 0 }
  57
  58     if {![catch {$w cget -takefocus} takefocus]} {
  59         switch -- $takefocus {
  60             0  -
  61             1  { return $takefocus }
  62             "" { return 0 }
  63             default {
  64                 set value [uplevel #0 $takefocus [list $w]]
  65                 return [expr {$value eq 1}]
  66             }
  67         }
  68     }
  69
  70     return 0
  71 }
  72
  73 ## ttk::focusFirst $w --
  74 #       Return the first descendant of $w, in preorder traversal order,
  75 #       that can take keyboard focus, "" if none do.
  76 #
  77 # See also: tk_focusNext
  78 #
  79
  80 proc ttk::focusFirst {w} {
  81     if {[ttk::takesFocus $w]} {
  82         return $w
  83     }
  84     foreach child [winfo children $w] {
  85         if {[set c [ttk::focusFirst $child]] ne ""} {
  86             return $c
  87         }
  88     }
  89     return ""
  90 }
  91
  92 ### Grabs.
  93 #
  94 # Rules:
  95 #       Each call to [grabWindow $w] or [globalGrab $w] must be
  96 #       matched with a call to [releaseGrab $w] in LIFO order.
  97 #
  98 #       Do not call [grabWindow $w] for a window that currently
  99 #       appears on the grab stack.
 100 #
 101 #       See #1239190 and #1411983 for more discussion.
 102 #
 103 namespace eval ttk {
 104     variable Grab               ;# map: window name -> grab token
 105
 106     # grab token details:
 107     #   Two-element list containing:
 108     #   1) a script to evaluate to restore the previous grab (if any);
 109     #   2) a script to evaluate to restore the focus (if any)
 110 }
 111
 112 ## SaveGrab --
 113 #       Record current grab and focus windows.
 114 #
 115 proc ttk::SaveGrab {w} {
 116     variable Grab
 117
 118     if {[info exists Grab($w)]} {
 119         # $w is already on the grab stack.
 120         # This should not happen, but bail out in case it does anyway:
 121         #
 122         return
 123     }
 124
 125     set restoreGrab [set restoreFocus ""]
 126
 127     set grabbed [grab current $w]
 128     if {[winfo exists $grabbed]} {
 129         switch [grab status $grabbed] {
 130             global { set restoreGrab [list grab -global $grabbed] }
 131             local  { set restoreGrab [list grab $grabbed] }
 132             none   { ;# grab window is really in a different interp }
 133         }
 134     }
 135
 136     set focus [focus]
 137     if {$focus ne ""} {
 138         set restoreFocus [list focus -force $focus]
 139     }
 140
 141     set Grab($w) [list $restoreGrab $restoreFocus]
 142 }
 143
 144 ## RestoreGrab --
 145 #       Restore previous grab and focus windows.
 146 #       If called more than once without an intervening [SaveGrab $w],
 147 #       does nothing.
 148 #
 149 proc ttk::RestoreGrab {w} {
 150     variable Grab
 151
 152     if {![info exists Grab($w)]} {      # Ignore
 153         return;
 154     }
 155
 156     # The previous grab/focus window may have been destroyed,
 157     # unmapped, or some other abnormal condition; ignore any errors.
 158     #
 159     foreach script $Grab($w) {
 160         catch $script
 161     }
 162
 163     unset Grab($w)
 164 }
 165
 166 ## ttk::grabWindow $w --
 167 #       Records the current focus and grab windows, sets an application-modal
 168 #       grab on window $w.
 169 #
 170 proc ttk::grabWindow {w} {
 171     SaveGrab $w
 172     grab $w
 173 }
 174
 175 ## ttk::globalGrab $w --
 176 #       Same as grabWindow, but sets a global grab on $w.
 177 #
 178 proc ttk::globalGrab {w} {
 179     SaveGrab $w
 180     grab -global $w
 181 }
 182
 183 ## ttk::releaseGrab --
 184 #       Release the grab previously set by [ttk::grabWindow]
 185 #       or [ttk::globalGrab].
 186 #
 187 proc ttk::releaseGrab {w} {
 188     grab release $w
 189     RestoreGrab $w
 190 }
 191
 192 ### Auto-repeat.
 193 #
 194 # NOTE: repeating widgets do not have -repeatdelay
 195 # or -repeatinterval resources as in standard Tk;
 196 # instead a single set of settings is applied application-wide.
 197 # (TODO: make this user-configurable)
 198 #
 199 # (@@@ Windows seems to use something like 500/50 milliseconds
 200 #  @@@ for -repeatdelay/-repeatinterval)
 201 #
 202
 203 namespace eval ttk {
 204     variable Repeat
 205     array set Repeat {
 206         delay           300
 207         interval        100
 208         timer           {}
 209         script          {}
 210     }
 211 }
 212
 213 ## ttk::Repeatedly --
 214 #       Begin auto-repeat.
 215 #
 216 proc ttk::Repeatedly {args} {
 217     variable Repeat
 218     after cancel $Repeat(timer)
 219     set script [uplevel 1 [list namespace code $args]]
 220     set Repeat(script) $script
 221     uplevel #0 $script
 222     set Repeat(timer) [after $Repeat(delay) ttk::Repeat]
 223 }
 224
 225 ## Repeat --
 226 #       Continue auto-repeat
 227 #
 228 proc ttk::Repeat {} {
 229     variable Repeat
 230     uplevel #0 $Repeat(script)
 231     set Repeat(timer) [after $Repeat(interval) ttk::Repeat]
 232 }
 233
 234 ## ttk::CancelRepeat --
 235 #       Halt auto-repeat.
 236 #
 237 proc ttk::CancelRepeat {} {
 238     variable Repeat
 239     after cancel $Repeat(timer)
 240 }
 241
 242 ### Bindings.
 243 #
 244
 245 ## ttk::copyBindings $from $to --
 246 #       Utility routine; copies bindings from one bindtag onto another.
 247 #
 248 proc ttk::copyBindings {from to} {
 249     foreach event [bind $from] {
 250         bind $to $event [bind $from $event]
 251     }
 252 }
 253
 254 ## Standard mousewheel bindings.
 255 #
 256 # Usage: [ttk::copyBindings TtkScrollable $bindtag]
 257 # adds mousewheel support to a scrollable widget.
 258 #
 259 # Platform inconsistencies:
 260 #
 261 # On X11, the server typically maps the mouse wheel to Button4 and Button5.
 262 #
 263 # On OSX, Tk generates sensible values for the %D field in <MouseWheel> events.
 264 #
 265 # On Windows, %D must be scaled by a factor of 120.
 266 # In addition, Tk redirects mousewheel events to the window with
 267 # keyboard focus instead of sending them to the window under the pointer.
 268 # We do not attempt to fix that here, see also TIP#171.
 269 #
 270 # OSX conventionally uses Shift+MouseWheel for horizontal scrolling,
 271 # and Option+MouseWheel for accelerated scrolling.
 272 #
 273 # The Shift+MouseWheel behavior is not conventional on Windows or most
 274 # X11 toolkits, but it's useful.
 275 #
 276 # MouseWheel scrolling is accelerated on X11, which is conventional
 277 # for Tk and appears to be conventional for other toolkits (although
 278 # Gtk+ and Qt do not appear to use as large a factor).
 279 #
 280
 281 switch -- [tk windowingsystem] {
 282     x11 {
 283         bind TtkScrollable <ButtonPress-4>       { %W yview scroll -5 units }
 284         bind TtkScrollable <ButtonPress-5>       { %W yview scroll  5 units }
 285         bind TtkScrollable <Shift-ButtonPress-4> { %W xview scroll -5 units }
 286         bind TtkScrollable <Shift-ButtonPress-5> { %W xview scroll  5 units }
 287     }
 288     win32 {
 289         bind TtkScrollable <MouseWheel> \
 290             { %W yview scroll [expr {-(%D/120)}] units }
 291         bind TtkScrollable <Shift-MouseWheel> \
 292             { %W xview scroll [expr {-(%D/120)}] units }
 293     }
 294     aqua {
 295         bind TtkScrollable <MouseWheel> \
 296             { %W yview scroll [expr {-(%D)}] units }
 297         bind TtkScrollable <Shift-MouseWheel> \
 298             { %W xview scroll [expr {-(%D)}] units }
 299         bind TtkScrollable <Option-MouseWheel> \
 300             { %W yview scroll  [expr {-10*(%D)}] units }
 301         bind TtkScrollable <Shift-Option-MouseWheel> \
 302             { %W xview scroll [expr {-10*(%D)}] units }
 303     }
 304 }
 305
 306 #*EOF*