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