| 1 | # scrlbar.tcl -- |
| 2 | # |
| 3 | # This file defines the default bindings for Tk scrollbar widgets. |
| 4 | # It also provides procedures that help in implementing the bindings. |
| 5 | # |
| 6 | # RCS: @(#) $Id: scrlbar.tcl,v 1.10.2.1 2004/02/17 07:17:17 das Exp $ |
| 7 | # |
| 8 | # Copyright (c) 1994 The Regents of the University of California. |
| 9 | # Copyright (c) 1994-1996 Sun Microsystems, Inc. |
| 10 | # |
| 11 | # See the file "license.terms" for information on usage and redistribution |
| 12 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
| 13 | # |
| 14 | |
| 15 | #------------------------------------------------------------------------- |
| 16 | # The code below creates the default class bindings for scrollbars. |
| 17 | #------------------------------------------------------------------------- |
| 18 | |
| 19 | # Standard Motif bindings: |
| 20 | if {[string equal [tk windowingsystem] "x11"]} { |
| 21 | |
| 22 | bind Scrollbar <Enter> { |
| 23 | if {$tk_strictMotif} { |
| 24 | set tk::Priv(activeBg) [%W cget -activebackground] |
| 25 | %W config -activebackground [%W cget -background] |
| 26 | } |
| 27 | %W activate [%W identify %x %y] |
| 28 | } |
| 29 | bind Scrollbar <Motion> { |
| 30 | %W activate [%W identify %x %y] |
| 31 | } |
| 32 | |
| 33 | # The "info exists" command in the following binding handles the |
| 34 | # situation where a Leave event occurs for a scrollbar without the Enter |
| 35 | # event. This seems to happen on some systems (such as Solaris 2.4) for |
| 36 | # unknown reasons. |
| 37 | |
| 38 | bind Scrollbar <Leave> { |
| 39 | if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} { |
| 40 | %W config -activebackground $tk::Priv(activeBg) |
| 41 | } |
| 42 | %W activate {} |
| 43 | } |
| 44 | bind Scrollbar <1> { |
| 45 | tk::ScrollButtonDown %W %x %y |
| 46 | } |
| 47 | bind Scrollbar <B1-Motion> { |
| 48 | tk::ScrollDrag %W %x %y |
| 49 | } |
| 50 | bind Scrollbar <B1-B2-Motion> { |
| 51 | tk::ScrollDrag %W %x %y |
| 52 | } |
| 53 | bind Scrollbar <ButtonRelease-1> { |
| 54 | tk::ScrollButtonUp %W %x %y |
| 55 | } |
| 56 | bind Scrollbar <B1-Leave> { |
| 57 | # Prevents <Leave> binding from being invoked. |
| 58 | } |
| 59 | bind Scrollbar <B1-Enter> { |
| 60 | # Prevents <Enter> binding from being invoked. |
| 61 | } |
| 62 | bind Scrollbar <2> { |
| 63 | tk::ScrollButton2Down %W %x %y |
| 64 | } |
| 65 | bind Scrollbar <B1-2> { |
| 66 | # Do nothing, since button 1 is already down. |
| 67 | } |
| 68 | bind Scrollbar <B2-1> { |
| 69 | # Do nothing, since button 2 is already down. |
| 70 | } |
| 71 | bind Scrollbar <B2-Motion> { |
| 72 | tk::ScrollDrag %W %x %y |
| 73 | } |
| 74 | bind Scrollbar <ButtonRelease-2> { |
| 75 | tk::ScrollButtonUp %W %x %y |
| 76 | } |
| 77 | bind Scrollbar <B1-ButtonRelease-2> { |
| 78 | # Do nothing: B1 release will handle it. |
| 79 | } |
| 80 | bind Scrollbar <B2-ButtonRelease-1> { |
| 81 | # Do nothing: B2 release will handle it. |
| 82 | } |
| 83 | bind Scrollbar <B2-Leave> { |
| 84 | # Prevents <Leave> binding from being invoked. |
| 85 | } |
| 86 | bind Scrollbar <B2-Enter> { |
| 87 | # Prevents <Enter> binding from being invoked. |
| 88 | } |
| 89 | bind Scrollbar <Control-1> { |
| 90 | tk::ScrollTopBottom %W %x %y |
| 91 | } |
| 92 | bind Scrollbar <Control-2> { |
| 93 | tk::ScrollTopBottom %W %x %y |
| 94 | } |
| 95 | |
| 96 | bind Scrollbar <Up> { |
| 97 | tk::ScrollByUnits %W v -1 |
| 98 | } |
| 99 | bind Scrollbar <Down> { |
| 100 | tk::ScrollByUnits %W v 1 |
| 101 | } |
| 102 | bind Scrollbar <Control-Up> { |
| 103 | tk::ScrollByPages %W v -1 |
| 104 | } |
| 105 | bind Scrollbar <Control-Down> { |
| 106 | tk::ScrollByPages %W v 1 |
| 107 | } |
| 108 | bind Scrollbar <Left> { |
| 109 | tk::ScrollByUnits %W h -1 |
| 110 | } |
| 111 | bind Scrollbar <Right> { |
| 112 | tk::ScrollByUnits %W h 1 |
| 113 | } |
| 114 | bind Scrollbar <Control-Left> { |
| 115 | tk::ScrollByPages %W h -1 |
| 116 | } |
| 117 | bind Scrollbar <Control-Right> { |
| 118 | tk::ScrollByPages %W h 1 |
| 119 | } |
| 120 | bind Scrollbar <Prior> { |
| 121 | tk::ScrollByPages %W hv -1 |
| 122 | } |
| 123 | bind Scrollbar <Next> { |
| 124 | tk::ScrollByPages %W hv 1 |
| 125 | } |
| 126 | bind Scrollbar <Home> { |
| 127 | tk::ScrollToPos %W 0 |
| 128 | } |
| 129 | bind Scrollbar <End> { |
| 130 | tk::ScrollToPos %W 1 |
| 131 | } |
| 132 | } |
| 133 | if {[string equal [tk windowingsystem] "classic"] |
| 134 | || [string equal [tk windowingsystem] "aqua"]} { |
| 135 | bind Scrollbar <MouseWheel> { |
| 136 | tk::ScrollByUnits %W v [expr {- (%D)}] |
| 137 | } |
| 138 | bind Scrollbar <Option-MouseWheel> { |
| 139 | tk::ScrollByUnits %W v [expr {-10 * (%D)}] |
| 140 | } |
| 141 | bind Scrollbar <Shift-MouseWheel> { |
| 142 | tk::ScrollByUnits %W h [expr {- (%D)}] |
| 143 | } |
| 144 | bind Scrollbar <Shift-Option-MouseWheel> { |
| 145 | tk::ScrollByUnits %W h [expr {-10 * (%D)}] |
| 146 | } |
| 147 | } |
| 148 | # tk::ScrollButtonDown -- |
| 149 | # This procedure is invoked when a button is pressed in a scrollbar. |
| 150 | # It changes the way the scrollbar is displayed and takes actions |
| 151 | # depending on where the mouse is. |
| 152 | # |
| 153 | # Arguments: |
| 154 | # w - The scrollbar widget. |
| 155 | # x, y - Mouse coordinates. |
| 156 | |
| 157 | proc tk::ScrollButtonDown {w x y} { |
| 158 | variable ::tk::Priv |
| 159 | set Priv(relief) [$w cget -activerelief] |
| 160 | $w configure -activerelief sunken |
| 161 | set element [$w identify $x $y] |
| 162 | if {[string equal $element "slider"]} { |
| 163 | ScrollStartDrag $w $x $y |
| 164 | } else { |
| 165 | ScrollSelect $w $element initial |
| 166 | } |
| 167 | } |
| 168 | |
| 169 | # ::tk::ScrollButtonUp -- |
| 170 | # This procedure is invoked when a button is released in a scrollbar. |
| 171 | # It cancels scans and auto-repeats that were in progress, and restores |
| 172 | # the way the active element is displayed. |
| 173 | # |
| 174 | # Arguments: |
| 175 | # w - The scrollbar widget. |
| 176 | # x, y - Mouse coordinates. |
| 177 | |
| 178 | proc ::tk::ScrollButtonUp {w x y} { |
| 179 | variable ::tk::Priv |
| 180 | tk::CancelRepeat |
| 181 | if {[info exists Priv(relief)]} { |
| 182 | # Avoid error due to spurious release events |
| 183 | $w configure -activerelief $Priv(relief) |
| 184 | ScrollEndDrag $w $x $y |
| 185 | $w activate [$w identify $x $y] |
| 186 | } |
| 187 | } |
| 188 | |
| 189 | # ::tk::ScrollSelect -- |
| 190 | # This procedure is invoked when a button is pressed over the scrollbar. |
| 191 | # It invokes one of several scrolling actions depending on where in |
| 192 | # the scrollbar the button was pressed. |
| 193 | # |
| 194 | # Arguments: |
| 195 | # w - The scrollbar widget. |
| 196 | # element - The element of the scrollbar that was selected, such |
| 197 | # as "arrow1" or "trough2". Shouldn't be "slider". |
| 198 | # repeat - Whether and how to auto-repeat the action: "noRepeat" |
| 199 | # means don't auto-repeat, "initial" means this is the |
| 200 | # first action in an auto-repeat sequence, and "again" |
| 201 | # means this is the second repetition or later. |
| 202 | |
| 203 | proc ::tk::ScrollSelect {w element repeat} { |
| 204 | variable ::tk::Priv |
| 205 | if {![winfo exists $w]} return |
| 206 | switch -- $element { |
| 207 | "arrow1" {ScrollByUnits $w hv -1} |
| 208 | "trough1" {ScrollByPages $w hv -1} |
| 209 | "trough2" {ScrollByPages $w hv 1} |
| 210 | "arrow2" {ScrollByUnits $w hv 1} |
| 211 | default {return} |
| 212 | } |
| 213 | if {[string equal $repeat "again"]} { |
| 214 | set Priv(afterId) [after [$w cget -repeatinterval] \ |
| 215 | [list tk::ScrollSelect $w $element again]] |
| 216 | } elseif {[string equal $repeat "initial"]} { |
| 217 | set delay [$w cget -repeatdelay] |
| 218 | if {$delay > 0} { |
| 219 | set Priv(afterId) [after $delay \ |
| 220 | [list tk::ScrollSelect $w $element again]] |
| 221 | } |
| 222 | } |
| 223 | } |
| 224 | |
| 225 | # ::tk::ScrollStartDrag -- |
| 226 | # This procedure is called to initiate a drag of the slider. It just |
| 227 | # remembers the starting position of the mouse and slider. |
| 228 | # |
| 229 | # Arguments: |
| 230 | # w - The scrollbar widget. |
| 231 | # x, y - The mouse position at the start of the drag operation. |
| 232 | |
| 233 | proc ::tk::ScrollStartDrag {w x y} { |
| 234 | variable ::tk::Priv |
| 235 | |
| 236 | if {[string equal [$w cget -command] ""]} { |
| 237 | return |
| 238 | } |
| 239 | set Priv(pressX) $x |
| 240 | set Priv(pressY) $y |
| 241 | set Priv(initValues) [$w get] |
| 242 | set iv0 [lindex $Priv(initValues) 0] |
| 243 | if {[llength $Priv(initValues)] == 2} { |
| 244 | set Priv(initPos) $iv0 |
| 245 | } elseif {$iv0 == 0} { |
| 246 | set Priv(initPos) 0.0 |
| 247 | } else { |
| 248 | set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \ |
| 249 | / [lindex $Priv(initValues) 0]}] |
| 250 | } |
| 251 | } |
| 252 | |
| 253 | # ::tk::ScrollDrag -- |
| 254 | # This procedure is called for each mouse motion even when the slider |
| 255 | # is being dragged. It notifies the associated widget if we're not |
| 256 | # jump scrolling, and it just updates the scrollbar if we are jump |
| 257 | # scrolling. |
| 258 | # |
| 259 | # Arguments: |
| 260 | # w - The scrollbar widget. |
| 261 | # x, y - The current mouse position. |
| 262 | |
| 263 | proc ::tk::ScrollDrag {w x y} { |
| 264 | variable ::tk::Priv |
| 265 | |
| 266 | if {[string equal $Priv(initPos) ""]} { |
| 267 | return |
| 268 | } |
| 269 | set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]] |
| 270 | if {[$w cget -jump]} { |
| 271 | if {[llength $Priv(initValues)] == 2} { |
| 272 | $w set [expr {[lindex $Priv(initValues) 0] + $delta}] \ |
| 273 | [expr {[lindex $Priv(initValues) 1] + $delta}] |
| 274 | } else { |
| 275 | set delta [expr {round($delta * [lindex $Priv(initValues) 0])}] |
| 276 | eval [list $w] set [lreplace $Priv(initValues) 2 3 \ |
| 277 | [expr {[lindex $Priv(initValues) 2] + $delta}] \ |
| 278 | [expr {[lindex $Priv(initValues) 3] + $delta}]] |
| 279 | } |
| 280 | } else { |
| 281 | ScrollToPos $w [expr {$Priv(initPos) + $delta}] |
| 282 | } |
| 283 | } |
| 284 | |
| 285 | # ::tk::ScrollEndDrag -- |
| 286 | # This procedure is called to end an interactive drag of the slider. |
| 287 | # It scrolls the window if we're in jump mode, otherwise it does nothing. |
| 288 | # |
| 289 | # Arguments: |
| 290 | # w - The scrollbar widget. |
| 291 | # x, y - The mouse position at the end of the drag operation. |
| 292 | |
| 293 | proc ::tk::ScrollEndDrag {w x y} { |
| 294 | variable ::tk::Priv |
| 295 | |
| 296 | if {[string equal $Priv(initPos) ""]} { |
| 297 | return |
| 298 | } |
| 299 | if {[$w cget -jump]} { |
| 300 | set delta [$w delta [expr {$x - $Priv(pressX)}] \ |
| 301 | [expr {$y - $Priv(pressY)}]] |
| 302 | ScrollToPos $w [expr {$Priv(initPos) + $delta}] |
| 303 | } |
| 304 | set Priv(initPos) "" |
| 305 | } |
| 306 | |
| 307 | # ::tk::ScrollByUnits -- |
| 308 | # This procedure tells the scrollbar's associated widget to scroll up |
| 309 | # or down by a given number of units. It notifies the associated widget |
| 310 | # in different ways for old and new command syntaxes. |
| 311 | # |
| 312 | # Arguments: |
| 313 | # w - The scrollbar widget. |
| 314 | # orient - Which kinds of scrollbars this applies to: "h" for |
| 315 | # horizontal, "v" for vertical, "hv" for both. |
| 316 | # amount - How many units to scroll: typically 1 or -1. |
| 317 | |
| 318 | proc ::tk::ScrollByUnits {w orient amount} { |
| 319 | set cmd [$w cget -command] |
| 320 | if {[string equal $cmd ""] || ([string first \ |
| 321 | [string index [$w cget -orient] 0] $orient] < 0)} { |
| 322 | return |
| 323 | } |
| 324 | set info [$w get] |
| 325 | if {[llength $info] == 2} { |
| 326 | uplevel #0 $cmd scroll $amount units |
| 327 | } else { |
| 328 | uplevel #0 $cmd [expr {[lindex $info 2] + $amount}] |
| 329 | } |
| 330 | } |
| 331 | |
| 332 | # ::tk::ScrollByPages -- |
| 333 | # This procedure tells the scrollbar's associated widget to scroll up |
| 334 | # or down by a given number of screenfuls. It notifies the associated |
| 335 | # widget in different ways for old and new command syntaxes. |
| 336 | # |
| 337 | # Arguments: |
| 338 | # w - The scrollbar widget. |
| 339 | # orient - Which kinds of scrollbars this applies to: "h" for |
| 340 | # horizontal, "v" for vertical, "hv" for both. |
| 341 | # amount - How many screens to scroll: typically 1 or -1. |
| 342 | |
| 343 | proc ::tk::ScrollByPages {w orient amount} { |
| 344 | set cmd [$w cget -command] |
| 345 | if {[string equal $cmd ""] || ([string first \ |
| 346 | [string index [$w cget -orient] 0] $orient] < 0)} { |
| 347 | return |
| 348 | } |
| 349 | set info [$w get] |
| 350 | if {[llength $info] == 2} { |
| 351 | uplevel #0 $cmd scroll $amount pages |
| 352 | } else { |
| 353 | uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}] |
| 354 | } |
| 355 | } |
| 356 | |
| 357 | # ::tk::ScrollToPos -- |
| 358 | # This procedure tells the scrollbar's associated widget to scroll to |
| 359 | # a particular location, given by a fraction between 0 and 1. It notifies |
| 360 | # the associated widget in different ways for old and new command syntaxes. |
| 361 | # |
| 362 | # Arguments: |
| 363 | # w - The scrollbar widget. |
| 364 | # pos - A fraction between 0 and 1 indicating a desired position |
| 365 | # in the document. |
| 366 | |
| 367 | proc ::tk::ScrollToPos {w pos} { |
| 368 | set cmd [$w cget -command] |
| 369 | if {[string equal $cmd ""]} { |
| 370 | return |
| 371 | } |
| 372 | set info [$w get] |
| 373 | if {[llength $info] == 2} { |
| 374 | uplevel #0 $cmd moveto $pos |
| 375 | } else { |
| 376 | uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}] |
| 377 | } |
| 378 | } |
| 379 | |
| 380 | # ::tk::ScrollTopBottom |
| 381 | # Scroll to the top or bottom of the document, depending on the mouse |
| 382 | # position. |
| 383 | # |
| 384 | # Arguments: |
| 385 | # w - The scrollbar widget. |
| 386 | # x, y - Mouse coordinates within the widget. |
| 387 | |
| 388 | proc ::tk::ScrollTopBottom {w x y} { |
| 389 | variable ::tk::Priv |
| 390 | set element [$w identify $x $y] |
| 391 | if {[string match *1 $element]} { |
| 392 | ScrollToPos $w 0 |
| 393 | } elseif {[string match *2 $element]} { |
| 394 | ScrollToPos $w 1 |
| 395 | } |
| 396 | |
| 397 | # Set Priv(relief), since it's needed by tk::ScrollButtonUp. |
| 398 | |
| 399 | set Priv(relief) [$w cget -activerelief] |
| 400 | } |
| 401 | |
| 402 | # ::tk::ScrollButton2Down |
| 403 | # This procedure is invoked when button 2 is pressed over a scrollbar. |
| 404 | # If the button is over the trough or slider, it sets the scrollbar to |
| 405 | # the mouse position and starts a slider drag. Otherwise it just |
| 406 | # behaves the same as button 1. |
| 407 | # |
| 408 | # Arguments: |
| 409 | # w - The scrollbar widget. |
| 410 | # x, y - Mouse coordinates within the widget. |
| 411 | |
| 412 | proc ::tk::ScrollButton2Down {w x y} { |
| 413 | variable ::tk::Priv |
| 414 | set element [$w identify $x $y] |
| 415 | if {[string match {arrow[12]} $element]} { |
| 416 | ScrollButtonDown $w $x $y |
| 417 | return |
| 418 | } |
| 419 | ScrollToPos $w [$w fraction $x $y] |
| 420 | set Priv(relief) [$w cget -activerelief] |
| 421 | |
| 422 | # Need the "update idletasks" below so that the widget calls us |
| 423 | # back to reset the actual scrollbar position before we start the |
| 424 | # slider drag. |
| 425 | |
| 426 | update idletasks |
| 427 | $w configure -activerelief sunken |
| 428 | $w activate slider |
| 429 | ScrollStartDrag $w $x $y |
| 430 | } |