util/X86LINUX64/lib/tk8.6/scrlbar.tcl

   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 <4> {tk::ScrollByUnits %W v -5}
 156         bind Scrollbar <5> {tk::ScrollByUnits %W v 5}
 157         bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5}
 158         bind Scrollbar <Shift-5> {tk::ScrollByUnits %W h 5}
 159     }
 160 }
 161 # tk::ScrollButtonDown --
 162 # This procedure is invoked when a button is pressed in a scrollbar.
 163 # It changes the way the scrollbar is displayed and takes actions
 164 # depending on where the mouse is.
 165 #
 166 # Arguments:
 167 # w -           The scrollbar widget.
 168 # x, y -        Mouse coordinates.
 169
 170 proc tk::ScrollButtonDown {w x y} {
 171     variable ::tk::Priv
 172     set Priv(relief) [$w cget -activerelief]
 173     $w configure -activerelief sunken
 174     set element [$w identify $x $y]
 175     if {$element eq "slider"} {
 176         ScrollStartDrag $w $x $y
 177     } else {
 178         ScrollSelect $w $element initial
 179     }
 180 }
 181
 182 # ::tk::ScrollButtonUp --
 183 # This procedure is invoked when a button is released in a scrollbar.
 184 # It cancels scans and auto-repeats that were in progress, and restores
 185 # the way the active element is displayed.
 186 #
 187 # Arguments:
 188 # w -           The scrollbar widget.
 189 # x, y -        Mouse coordinates.
 190
 191 proc ::tk::ScrollButtonUp {w x y} {
 192     variable ::tk::Priv
 193     tk::CancelRepeat
 194     if {[info exists Priv(relief)]} {
 195         # Avoid error due to spurious release events
 196         $w configure -activerelief $Priv(relief)
 197         ScrollEndDrag $w $x $y
 198         $w activate [$w identify $x $y]
 199     }
 200 }
 201
 202 # ::tk::ScrollSelect --
 203 # This procedure is invoked when a button is pressed over the scrollbar.
 204 # It invokes one of several scrolling actions depending on where in
 205 # the scrollbar the button was pressed.
 206 #
 207 # Arguments:
 208 # w -           The scrollbar widget.
 209 # element -     The element of the scrollbar that was selected, such
 210 #               as "arrow1" or "trough2".  Shouldn't be "slider".
 211 # repeat -      Whether and how to auto-repeat the action:  "noRepeat"
 212 #               means don't auto-repeat, "initial" means this is the
 213 #               first action in an auto-repeat sequence, and "again"
 214 #               means this is the second repetition or later.
 215
 216 proc ::tk::ScrollSelect {w element repeat} {
 217     variable ::tk::Priv
 218     if {![winfo exists $w]} return
 219     switch -- $element {
 220         "arrow1"        {ScrollByUnits $w hv -1}
 221         "trough1"       {ScrollByPages $w hv -1}
 222         "trough2"       {ScrollByPages $w hv 1}
 223         "arrow2"        {ScrollByUnits $w hv 1}
 224         default         {return}
 225     }
 226     if {$repeat eq "again"} {
 227         set Priv(afterId) [after [$w cget -repeatinterval] \
 228                 [list tk::ScrollSelect $w $element again]]
 229     } elseif {$repeat eq "initial"} {
 230         set delay [$w cget -repeatdelay]
 231         if {$delay > 0} {
 232             set Priv(afterId) [after $delay \
 233                     [list tk::ScrollSelect $w $element again]]
 234         }
 235     }
 236 }
 237
 238 # ::tk::ScrollStartDrag --
 239 # This procedure is called to initiate a drag of the slider.  It just
 240 # remembers the starting position of the mouse and slider.
 241 #
 242 # Arguments:
 243 # w -           The scrollbar widget.
 244 # x, y -        The mouse position at the start of the drag operation.
 245
 246 proc ::tk::ScrollStartDrag {w x y} {
 247     variable ::tk::Priv
 248
 249     if {[$w cget -command] eq ""} {
 250         return
 251     }
 252     set Priv(pressX) $x
 253     set Priv(pressY) $y
 254     set Priv(initValues) [$w get]
 255     set iv0 [lindex $Priv(initValues) 0]
 256     if {[llength $Priv(initValues)] == 2} {
 257         set Priv(initPos) $iv0
 258     } elseif {$iv0 == 0} {
 259         set Priv(initPos) 0.0
 260     } else {
 261         set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \
 262                 / [lindex $Priv(initValues) 0]}]
 263     }
 264 }
 265
 266 # ::tk::ScrollDrag --
 267 # This procedure is called for each mouse motion even when the slider
 268 # is being dragged.  It notifies the associated widget if we're not
 269 # jump scrolling, and it just updates the scrollbar if we are jump
 270 # scrolling.
 271 #
 272 # Arguments:
 273 # w -           The scrollbar widget.
 274 # x, y -        The current mouse position.
 275
 276 proc ::tk::ScrollDrag {w x y} {
 277     variable ::tk::Priv
 278
 279     if {$Priv(initPos) eq ""} {
 280         return
 281     }
 282     set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]]
 283     if {[$w cget -jump]} {
 284         if {[llength $Priv(initValues)] == 2} {
 285             $w set [expr {[lindex $Priv(initValues) 0] + $delta}] \
 286                     [expr {[lindex $Priv(initValues) 1] + $delta}]
 287         } else {
 288             set delta [expr {round($delta * [lindex $Priv(initValues) 0])}]
 289             eval [list $w] set [lreplace $Priv(initValues) 2 3 \
 290                     [expr {[lindex $Priv(initValues) 2] + $delta}] \
 291                     [expr {[lindex $Priv(initValues) 3] + $delta}]]
 292         }
 293     } else {
 294         ScrollToPos $w [expr {$Priv(initPos) + $delta}]
 295     }
 296 }
 297
 298 # ::tk::ScrollEndDrag --
 299 # This procedure is called to end an interactive drag of the slider.
 300 # It scrolls the window if we're in jump mode, otherwise it does nothing.
 301 #
 302 # Arguments:
 303 # w -           The scrollbar widget.
 304 # x, y -        The mouse position at the end of the drag operation.
 305
 306 proc ::tk::ScrollEndDrag {w x y} {
 307     variable ::tk::Priv
 308
 309     if {$Priv(initPos) eq ""} {
 310         return
 311     }
 312     if {[$w cget -jump]} {
 313         set delta [$w delta [expr {$x - $Priv(pressX)}] \
 314                 [expr {$y - $Priv(pressY)}]]
 315         ScrollToPos $w [expr {$Priv(initPos) + $delta}]
 316     }
 317     set Priv(initPos) ""
 318 }
 319
 320 # ::tk::ScrollByUnits --
 321 # This procedure tells the scrollbar's associated widget to scroll up
 322 # or down by a given number of units.  It notifies the associated widget
 323 # in different ways for old and new command syntaxes.
 324 #
 325 # Arguments:
 326 # w -           The scrollbar widget.
 327 # orient -      Which kinds of scrollbars this applies to:  "h" for
 328 #               horizontal, "v" for vertical, "hv" for both.
 329 # amount -      How many units to scroll:  typically 1 or -1.
 330
 331 proc ::tk::ScrollByUnits {w orient amount} {
 332     set cmd [$w cget -command]
 333     if {$cmd eq "" || ([string first \
 334             [string index [$w cget -orient] 0] $orient] < 0)} {
 335         return
 336     }
 337     set info [$w get]
 338     if {[llength $info] == 2} {
 339         uplevel #0 $cmd scroll $amount units
 340     } else {
 341         uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]
 342     }
 343 }
 344
 345 # ::tk::ScrollByPages --
 346 # This procedure tells the scrollbar's associated widget to scroll up
 347 # or down by a given number of screenfuls.  It notifies the associated
 348 # widget in different ways for old and new command syntaxes.
 349 #
 350 # Arguments:
 351 # w -           The scrollbar widget.
 352 # orient -      Which kinds of scrollbars this applies to:  "h" for
 353 #               horizontal, "v" for vertical, "hv" for both.
 354 # amount -      How many screens to scroll:  typically 1 or -1.
 355
 356 proc ::tk::ScrollByPages {w orient amount} {
 357     set cmd [$w cget -command]
 358     if {$cmd eq "" || ([string first \
 359             [string index [$w cget -orient] 0] $orient] < 0)} {
 360         return
 361     }
 362     set info [$w get]
 363     if {[llength $info] == 2} {
 364         uplevel #0 $cmd scroll $amount pages
 365     } else {
 366         uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]
 367     }
 368 }
 369
 370 # ::tk::ScrollToPos --
 371 # This procedure tells the scrollbar's associated widget to scroll to
 372 # a particular location, given by a fraction between 0 and 1.  It notifies
 373 # the associated widget in different ways for old and new command syntaxes.
 374 #
 375 # Arguments:
 376 # w -           The scrollbar widget.
 377 # pos -         A fraction between 0 and 1 indicating a desired position
 378 #               in the document.
 379
 380 proc ::tk::ScrollToPos {w pos} {
 381     set cmd [$w cget -command]
 382     if {$cmd eq ""} {
 383         return
 384     }
 385     set info [$w get]
 386     if {[llength $info] == 2} {
 387         uplevel #0 $cmd moveto $pos
 388     } else {
 389         uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]
 390     }
 391 }
 392
 393 # ::tk::ScrollTopBottom
 394 # Scroll to the top or bottom of the document, depending on the mouse
 395 # position.
 396 #
 397 # Arguments:
 398 # w -           The scrollbar widget.
 399 # x, y -        Mouse coordinates within the widget.
 400
 401 proc ::tk::ScrollTopBottom {w x y} {
 402     variable ::tk::Priv
 403     set element [$w identify $x $y]
 404     if {[string match *1 $element]} {
 405         ScrollToPos $w 0
 406     } elseif {[string match *2 $element]} {
 407         ScrollToPos $w 1
 408     }
 409
 410     # Set Priv(relief), since it's needed by tk::ScrollButtonUp.
 411
 412     set Priv(relief) [$w cget -activerelief]
 413 }
 414
 415 # ::tk::ScrollButton2Down
 416 # This procedure is invoked when button 2 is pressed over a scrollbar.
 417 # If the button is over the trough or slider, it sets the scrollbar to
 418 # the mouse position and starts a slider drag.  Otherwise it just
 419 # behaves the same as button 1.
 420 #
 421 # Arguments:
 422 # w -           The scrollbar widget.
 423 # x, y -        Mouse coordinates within the widget.
 424
 425 proc ::tk::ScrollButton2Down {w x y} {
 426     variable ::tk::Priv
 427     set element [$w identify $x $y]
 428     if {[string match {arrow[12]} $element]} {
 429         ScrollButtonDown $w $x $y
 430         return
 431     }
 432     ScrollToPos $w [$w fraction $x $y]
 433     set Priv(relief) [$w cget -activerelief]
 434
 435     # Need the "update idletasks" below so that the widget calls us
 436     # back to reset the actual scrollbar position before we start the
 437     # slider drag.
 438
 439     update idletasks
 440     $w configure -activerelief sunken
 441     $w activate slider
 442     ScrollStartDrag $w $x $y
 443 }