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