scrlbar.tcl –

This file defines the default bindings for Tk scrollbar widgets.

It also provides procedures that help in implementing the bindings.

RCS: @(#) $Id: scrlbar.tcl,v 1.10.2.3 2006/03/17 10:50:11 patthoyts Exp $

Copyright (c) 1994 The Regents of the University of California.

Copyright (c) 1994-1996 Sun Microsystems, Inc.

See the file “license.terms” for information on usage and redistribution

of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#———————————————————————––

The code below creates the default class bindings for scrollbars.

#———————————————————————––

Standard Motif bindings:

if {[tk windowingsystem] eq “x11”} {

bind Scrollbar {
if {$tk_strictMotif} {
set tk::Priv(activeBg) [%W cget -activebackground]
%W configure -activebackground [%W cget -background]
}
%W activate [%W identify %x %y]
}
bind Scrollbar {
%W activate [%W identify %x %y]
}

The “info exists” command in the following binding handles the

situation where a Leave event occurs for a scrollbar without the Enter

event. This seems to happen on some systems (such as Solaris 2.4) for

unknown reasons.

bind Scrollbar {
if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} {
%W configure -activebackground $tk::Priv(activeBg)
}
%W activate {}
}
bind Scrollbar <1> {
tk::ScrollButtonDown %W %x %y
}
bind Scrollbar {
tk::ScrollDrag %W %x %y
}
bind Scrollbar {
tk::ScrollDrag %W %x %y
}
bind Scrollbar {
tk::ScrollButtonUp %W %x %y
}
bind Scrollbar {
# Prevents binding from being invoked.
}
bind Scrollbar {
# Prevents binding from being invoked.
}
bind Scrollbar <2> {
tk::ScrollButton2Down %W %x %y
}
bind Scrollbar {
# Do nothing, since button 1 is already down.
}
bind Scrollbar {
# Do nothing, since button 2 is already down.
}
bind Scrollbar {
tk::ScrollDrag %W %x %y
}
bind Scrollbar {
tk::ScrollButtonUp %W %x %y
}
bind Scrollbar {
# Do nothing: B1 release will handle it.
}
bind Scrollbar {
# Do nothing: B2 release will handle it.
}
bind Scrollbar {
# Prevents binding from being invoked.
}
bind Scrollbar {
# Prevents binding from being invoked.
}
bind Scrollbar {
tk::ScrollTopBottom %W %x %y
}
bind Scrollbar {
tk::ScrollTopBottom %W %x %y
}

bind Scrollbar {
tk::ScrollByUnits %W v -1
}
bind Scrollbar {
tk::ScrollByUnits %W v 1
}
bind Scrollbar {
tk::ScrollByPages %W v -1
}
bind Scrollbar {
tk::ScrollByPages %W v 1
}
bind Scrollbar {
tk::ScrollByUnits %W h -1
}
bind Scrollbar {
tk::ScrollByUnits %W h 1
}
bind Scrollbar {
tk::ScrollByPages %W h -1
}
bind Scrollbar {
tk::ScrollByPages %W h 1
}
bind Scrollbar {
tk::ScrollByPages %W hv -1
}
bind Scrollbar {
tk::ScrollByPages %W hv 1
}
bind Scrollbar {
tk::ScrollToPos %W 0
}
bind Scrollbar {
tk::ScrollToPos %W 1
}
}
if {[tk windowingsystem] eq “classic” || [tk windowingsystem] eq “aqua”} {
bind Scrollbar {
tk::ScrollByUnits %W v [expr {- (%D)}]
}
bind Scrollbar {
tk::ScrollByUnits %W v [expr {-10 * (%D)}]
}
bind Scrollbar {
tk::ScrollByUnits %W h [expr {- (%D)}]
}
bind Scrollbar {
tk::ScrollByUnits %W h [expr {-10 * (%D)}]
}
}

tk::ScrollButtonDown –

This procedure is invoked when a button is pressed in a scrollbar.

It changes the way the scrollbar is displayed and takes actions

depending on where the mouse is.

Arguments:

w - The scrollbar widget.

x, y - Mouse coordinates.

proc tk::ScrollButtonDown {w x y} {
variable ::tk::Priv
set Priv(relief) [$w cget -activerelief]
w configure -activerelief sunken set element [w identify $x y] if {element eq “slider”} {
ScrollStartDrag $w $x $y
} else {
ScrollSelect $w $element initial
}
}

::tk::ScrollButtonUp –

This procedure is invoked when a button is released in a scrollbar.

It cancels scans and auto-repeats that were in progress, and restores

the way the active element is displayed.

Arguments:

w - The scrollbar widget.

x, y - Mouse coordinates.

proc ::tk::ScrollButtonUp {w x y} {
variable ::tk::Priv
tk::CancelRepeat
if {[info exists Priv(relief)]} {
# Avoid error due to spurious release events
$w configure -activerelief $Priv(relief)
ScrollEndDrag $w $x $y
w activate [w identify $x $y]
}
}

::tk::ScrollSelect –

This procedure is invoked when a button is pressed over the scrollbar.

It invokes one of several scrolling actions depending on where in

the scrollbar the button was pressed.

Arguments:

w - The scrollbar widget.

element - The element of the scrollbar that was selected, such

as “arrow1” or “trough2”. Shouldn’t be “slider”.

repeat - Whether and how to auto-repeat the action: “noRepeat”

means don’t auto-repeat, “initial” means this is the

first action in an auto-repeat sequence, and “again”

means this is the second repetition or later.

proc ::tk::ScrollSelect {w element repeat} {
variable ::tk::Priv
if {![winfo exists $w]} return
switch – $element {
“arrow1” {ScrollByUnits $w hv -1}
“trough1” {ScrollByPages $w hv -1}
“trough2” {ScrollByPages $w hv 1}
“arrow2” {ScrollByUnits w hv 1} default {return} } if {repeat eq “again”} {
set Priv(afterId) [after [$w cget -repeatinterval]
[list tk::ScrollSelect $w element again]] } elseif {repeat eq “initial”} {
set delay [w cget -repeatdelay] if {delay > 0} {
set Priv(afterId) [after $delay
[list tk::ScrollSelect $w $element again]]
}
}
}

::tk::ScrollStartDrag –

This procedure is called to initiate a drag of the slider. It just

remembers the starting position of the mouse and slider.

Arguments:

w - The scrollbar widget.

x, y - The mouse position at the start of the drag operation.

proc ::tk::ScrollStartDrag {w x y} {
variable ::tk::Priv

if {[$w cget -command] eq ""} {
return
}
set Priv(pressX) $x
set Priv(pressY) $y
set Priv(initValues) [$w get]
set iv0 [lindex $Priv(initValues) 0]
if {[llength $Priv(initValues)] == 2} {
set Priv(initPos) $iv0
} elseif {$iv0 == 0} {
set Priv(initPos) 0.0
} else {
set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \
	/ [lindex $Priv(initValues) 0]}]
}

}

::tk::ScrollDrag –

This procedure is called for each mouse motion even when the slider

is being dragged. It notifies the associated widget if we’re not

jump scrolling, and it just updates the scrollbar if we are jump

scrolling.

Arguments:

w - The scrollbar widget.

x, y - The current mouse position.

proc ::tk::ScrollDrag {w x y} {
variable ::tk::Priv

if {$Priv(initPos) eq ""} {
return
}
set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]]
if {[$w cget -jump]} {
if {[llength $Priv(initValues)] == 2} {
    $w set [expr {[lindex $Priv(initValues) 0] + $delta}] \
	    [expr {[lindex $Priv(initValues) 1] + $delta}]
} else {
    set delta [expr {round($delta * [lindex $Priv(initValues) 0])}]
    eval [list $w] set [lreplace $Priv(initValues) 2 3 \
	    [expr {[lindex $Priv(initValues) 2] + $delta}] \
	    [expr {[lindex $Priv(initValues) 3] + $delta}]]
}
} else {
ScrollToPos $w [expr {$Priv(initPos) + $delta}]
}

}

::tk::ScrollEndDrag –

This procedure is called to end an interactive drag of the slider.

It scrolls the window if we’re in jump mode, otherwise it does nothing.

Arguments:

w - The scrollbar widget.

x, y - The mouse position at the end of the drag operation.

proc ::tk::ScrollEndDrag {w x y} {
variable ::tk::Priv

if {$Priv(initPos) eq ""} {
return
}
if {[$w cget -jump]} {
set delta [$w delta [expr {$x - $Priv(pressX)}] \
	[expr {$y - $Priv(pressY)}]]
ScrollToPos $w [expr {$Priv(initPos) + $delta}]
}
set Priv(initPos) ""

}

::tk::ScrollByUnits –

This procedure tells the scrollbar’s associated widget to scroll up

or down by a given number of units. It notifies the associated widget

in different ways for old and new command syntaxes.

Arguments:

w - The scrollbar widget.

orient - Which kinds of scrollbars this applies to: “h” for

horizontal, “v” for vertical, “hv” for both.

amount - How many units to scroll: typically 1 or -1.

proc ::tk::ScrollByUnits {w orient amount} {
set cmd [w cget -command] if {cmd eq “” || ([string first [string index [$w cget -orient] 0] orient] < 0)} { return } set info [w get]
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount units
} else {
uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]
}
}

::tk::ScrollByPages –

This procedure tells the scrollbar’s associated widget to scroll up

or down by a given number of screenfuls. It notifies the associated

widget in different ways for old and new command syntaxes.

Arguments:

w - The scrollbar widget.

orient - Which kinds of scrollbars this applies to: “h” for

horizontal, “v” for vertical, “hv” for both.

amount - How many screens to scroll: typically 1 or -1.

proc ::tk::ScrollByPages {w orient amount} {
set cmd [w cget -command] if {cmd eq “” || ([string first [string index [$w cget -orient] 0] orient] < 0)} { return } set info [w get]
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount pages
} else {
uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]
}
}

::tk::ScrollToPos –

This procedure tells the scrollbar’s associated widget to scroll to

a particular location, given by a fraction between 0 and 1. It notifies

the associated widget in different ways for old and new command syntaxes.

Arguments:

w - The scrollbar widget.

pos - A fraction between 0 and 1 indicating a desired position

in the document.

proc ::tk::ScrollToPos {w pos} {
set cmd [w cget -command] if {cmd eq “”} {
return
}
set info [$w get]
if {[llength $info] == 2} {
uplevel #0 $cmd moveto $pos
} else {
uplevel #0 $cmd [expr {round([lindex info 0]*pos)}]
}
}

::tk::ScrollTopBottom

Scroll to the top or bottom of the document, depending on the mouse

position.

Arguments:

w - The scrollbar widget.

x, y - Mouse coordinates within the widget.

proc ::tk::ScrollTopBottom {w x y} {
variable ::tk::Priv
set element [$w identify $x $y]
if {[string match *1 $element]} {
ScrollToPos $w 0
} elseif {[string match *2 $element]} {
ScrollToPos $w 1
}

# Set Priv(relief), since it's needed by tk::ScrollButtonUp.

set Priv(relief) [$w cget -activerelief]

}

::tk::ScrollButton2Down

This procedure is invoked when button 2 is pressed over a scrollbar.

If the button is over the trough or slider, it sets the scrollbar to

the mouse position and starts a slider drag. Otherwise it just

behaves the same as button 1.

Arguments:

w - The scrollbar widget.

x, y - Mouse coordinates within the widget.

proc ::tk::ScrollButton2Down {w x y} {
variable ::tk::Priv
set element [$w identify $x $y]
if {[string match {arrow[12]} $element]} {
ScrollButtonDown $w $x $y
return
}
ScrollToPos w [w fraction $x y] set Priv(relief) [w cget -activerelief]

# Need the "update idletasks" below so that the widget calls us
# back to reset the actual scrollbar position before we start the
# slider drag.

update idletasks
$w configure -activerelief sunken
$w activate slider
ScrollStartDrag $w $x $y

}