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