3 # This file defines the default bindings for Tk scrollbar widgets.
4 # It also provides procedures that help in implementing the bindings.
6 # Copyright (c) 1994 The Regents of the University of California.
7 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
9 # See the file "license.terms" for information on usage and redistribution
10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 #-------------------------------------------------------------------------
14 # The code below creates the default class bindings for scrollbars.
15 #-------------------------------------------------------------------------
18 ckScrollByUnits %W v -1
20 bind Scrollbar <Down> {
21 ckScrollByUnits %W v 1
23 bind Scrollbar <Left> {
24 ckScrollByUnits %W h -1
26 bind Scrollbar <Right> {
27 ckScrollByUnits %W h 1
29 bind Scrollbar <Prior> {
30 ckScrollByPages %W hv -1
32 bind Scrollbar <Next> {
33 ckScrollByPages %W hv 1
35 bind Scrollbar <Home> {
38 bind Scrollbar <End> {
41 bind Scrollbar <Button-1> {
42 ckScrollByButton %W %x %y
45 bind Scrollbar <FocusIn> {%W activate}
46 bind Scrollbar <FocusOut> {%W deactivate}
49 # This procedure tells the scrollbar's associated widget to scroll up
50 # or down by a given number of units. It notifies the associated widget
51 # in different ways for old and new command syntaxes.
54 # w - The scrollbar widget.
55 # orient - Which kinds of scrollbars this applies to: "h" for
56 # horizontal, "v" for vertical, "hv" for both.
57 # amount - How many units to scroll: typically 1 or -1.
59 proc ckScrollByUnits {w orient amount} {
60 set cmd [$w cget -command]
61 if {($cmd == "") || ([string first \
62 [string index [$w cget -orient] 0] $orient] < 0)} {
66 if {[llength $info] == 2} {
67 uplevel #0 $cmd scroll $amount units
69 uplevel #0 $cmd [expr [lindex $info 2] + $amount]
74 # This procedure tells the scrollbar's associated widget to scroll up
75 # or down by a given number of screenfuls. It notifies the associated
76 # widget in different ways for old and new command syntaxes.
79 # w - The scrollbar widget.
80 # orient - Which kinds of scrollbars this applies to: "h" for
81 # horizontal, "v" for vertical, "hv" for both.
82 # amount - How many screens to scroll: typically 1 or -1.
84 proc ckScrollByPages {w orient amount} {
85 set cmd [$w cget -command]
86 if {($cmd == "") || ([string first \
87 [string index [$w cget -orient] 0] $orient] < 0)} {
91 if {[llength $info] == 2} {
92 uplevel #0 $cmd scroll $amount pages
94 uplevel #0 $cmd [expr [lindex $info 2] + $amount*([lindex $info 1] - 1)]
99 # This procedure tells the scrollbar's associated widget to scroll to
100 # a particular location, given by a fraction between 0 and 1. It notifies
101 # the associated widget in different ways for old and new command syntaxes.
104 # w - The scrollbar widget.
105 # pos - A fraction between 0 and 1 indicating a desired position
108 proc ckScrollToPos {w pos} {
109 set cmd [$w cget -command]
114 if {[llength $info] == 2} {
115 uplevel #0 $cmd moveto $pos
117 uplevel #0 $cmd [expr round([lindex $info 0]*$pos)]
121 # ckScrollByButton --
122 # This procedure is invoked for button presses on any element of the
126 # w - The scrollbar widget.
127 # x, y - Mouse coordinates of button press.
129 proc ckScrollByButton {w x y} {
130 set element [$w identify $x $y]
131 if {$element == "arrow1"} {
132 ckScrollByUnits $w hv -1
133 } elseif {$element == "trough1"} {
134 ckScrollByPages $w hv -1
135 } elseif {$element == "trough2"} {
136 ckScrollByPages $w hv 1
137 } elseif {$element == "arrow2"} {
138 ckScrollByUnits $w hv 1