3 # This file defines the default bindings for Tk scale widgets and provides
4 # 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 entries.
15 #-------------------------------------------------------------------------
17 # Standard Motif bindings:
20 if {$tk_strictMotif} {
21 set tk::Priv(activeBg
) [%W cget
-activebackground]
22 %W configure
-activebackground [%W cget
-background]
24 tk::ScaleActivate %W
%x
%y
27 tk::ScaleActivate %W
%x
%y
30 if {$tk_strictMotif} {
31 %W configure
-activebackground $tk::Priv(activeBg
)
33 if {[%W cget
-state] eq
"active"} {
34 %W configure
-state normal
38 tk::ScaleButtonDown %W
%x
%y
40 bind Scale
<B1-Motion
> {
41 tk::ScaleDrag %W
%x
%y
43 bind Scale
<B1-Leave
> { }
44 bind Scale
<B1-Enter
> { }
45 bind Scale
<ButtonRelease-1
> {
48 tk::ScaleActivate %W
%x
%y
51 tk::ScaleButton2Down %W
%x
%y
53 bind Scale
<B2-Motion
> {
54 tk::ScaleDrag %W
%x
%y
56 bind Scale
<B2-Leave
> { }
57 bind Scale
<B2-Enter
> { }
58 bind Scale
<ButtonRelease-2
> {
61 tk::ScaleActivate %W
%x
%y
63 if {$tcl_platform(platform
) eq
"windows"} {
64 # On Windows do the same with button 3, as that is the right mouse button
65 bind Scale
<3> [bind Scale
<2>]
66 bind Scale
<B3-Motion
> [bind Scale
<B2-Motion
>]
67 bind Scale
<B3-Leave
> [bind Scale
<B2-Leave
>]
68 bind Scale
<B3-Enter
> [bind Scale
<B2-Enter
>]
69 bind Scale
<ButtonRelease-3
> [bind Scale
<ButtonRelease-2
>]
71 bind Scale
<Control-1
> {
72 tk::ScaleControlPress %W
%x
%y
75 tk::ScaleIncrement %W up little noRepeat
78 tk::ScaleIncrement %W down little noRepeat
81 tk::ScaleIncrement %W up little noRepeat
84 tk::ScaleIncrement %W down little noRepeat
86 bind Scale
<Control-Up
> {
87 tk::ScaleIncrement %W up big noRepeat
89 bind Scale
<Control-Down
> {
90 tk::ScaleIncrement %W down big noRepeat
92 bind Scale
<Control-Left
> {
93 tk::ScaleIncrement %W up big noRepeat
95 bind Scale
<Control-Right
> {
96 tk::ScaleIncrement %W down big noRepeat
99 %W
set [%W cget
-from]
105 # ::tk::ScaleActivate --
106 # This procedure is invoked to check a given x-y position in the
107 # scale and activate the slider if the x-y position falls within
111 # w - The scale widget.
112 # x, y - Mouse coordinates.
114 proc ::tk::ScaleActivate {w x y
} {
115 if {[$w cget
-state] eq
"disabled"} {
118 if {[$w identify
$x $y] eq
"slider"} {
123 if {[$w cget
-state] ne
$state} {
124 $w configure
-state $state
128 # ::tk::ScaleButtonDown --
129 # This procedure is invoked when a button is pressed in a scale. It
130 # takes different actions depending on where the button was pressed.
133 # w - The scale widget.
134 # x, y - Mouse coordinates of button press.
136 proc ::tk::ScaleButtonDown {w x y
} {
139 set el
[$w identify
$x $y]
142 set Priv
($w,relief
) [$w cget
-sliderrelief]
144 if {$el eq
"trough1"} {
145 ScaleIncrement
$w up little initial
146 } elseif
{$el eq
"trough2"} {
147 ScaleIncrement
$w down little initial
148 } elseif
{$el eq
"slider"} {
150 set Priv
(initValue
) [$w get
]
151 set coords
[$w coords
]
152 set Priv
(deltaX
) [expr {$x - [lindex $coords 0]}]
153 set Priv
(deltaY
) [expr {$y - [lindex $coords 1]}]
154 switch -exact -- $Priv($w,relief
) {
155 "raised" { $w configure
-sliderrelief sunken
}
156 "ridge" { $w configure
-sliderrelief groove
}
162 # This procedure is called when the mouse is dragged with
163 # mouse button 1 down. If the drag started inside the slider
164 # (i.e. the scale is active) then the scale's value is adjusted
165 # to reflect the mouse's position.
168 # w - The scale widget.
169 # x, y - Mouse coordinates.
171 proc ::tk::ScaleDrag {w x y
} {
173 if {!$Priv(dragging
)} {
176 $w set [$w get
[expr {$x-$Priv(deltaX
)}] [expr {$y-$Priv(deltaY
)}]]
179 # ::tk::ScaleEndDrag --
180 # This procedure is called to end an interactive drag of the
181 # slider. It just marks the drag as over.
184 # w - The scale widget.
186 proc ::tk::ScaleEndDrag {w
} {
189 if {[info exists Priv
($w,relief
)]} {
190 $w configure
-sliderrelief $Priv($w,relief
)
191 unset Priv
($w,relief
)
195 # ::tk::ScaleIncrement --
196 # This procedure is invoked to increment the value of a scale and
197 # to set up auto-repeating of the action if that is desired. The
198 # way the value is incremented depends on the "dir" and "big"
202 # w - The scale widget.
203 # dir - "up" means move value towards -from, "down" means
205 # big - Size of increments: "big" or "little".
206 # repeat - Whether and how to auto-repeat the action: "noRepeat"
207 # means don't auto-repeat, "initial" means this is the
208 # first action in an auto-repeat sequence, and "again"
209 # means this is the second repetition or later.
211 proc ::tk::ScaleIncrement {w dir big repeat
} {
213 if {![winfo exists
$w]} return
215 set inc
[$w cget
-bigincrement]
217 set inc
[expr {abs
([$w cget
-to] - [$w cget
-from])/10.0}]
219 if {$inc < [$w cget
-resolution]} {
220 set inc
[$w cget
-resolution]
223 set inc
[$w cget
-resolution]
225 if {([$w cget
-from] > [$w cget
-to]) ^
($dir eq
"up")} {
226 set inc
[expr {-$inc}]
228 $w set [expr {[$w get
] + $inc}]
230 if {$repeat eq
"again"} {
231 set Priv
(afterId
) [after [$w cget
-repeatinterval] \
232 [list tk::ScaleIncrement $w $dir $big again
]]
233 } elseif
{$repeat eq
"initial"} {
234 set delay
[$w cget
-repeatdelay]
236 set Priv
(afterId
) [after $delay \
237 [list tk::ScaleIncrement $w $dir $big again
]]
242 # ::tk::ScaleControlPress --
243 # This procedure handles button presses that are made with the Control
244 # key down. Depending on the mouse position, it adjusts the scale
245 # value to one end of the range or the other.
248 # w - The scale widget.
249 # x, y - Mouse coordinates where the button was pressed.
251 proc ::tk::ScaleControlPress {w x y
} {
252 set el
[$w identify
$x $y]
253 if {$el eq
"trough1"} {
254 $w set [$w cget
-from]
255 } elseif
{$el eq
"trough2"} {
260 # ::tk::ScaleButton2Down
261 # This procedure is invoked when button 2 is pressed over a scale.
262 # It sets the value to correspond to the mouse position and starts
266 # w - The scrollbar widget.
267 # x, y - Mouse coordinates within the widget.
269 proc ::tk::ScaleButton2Down {w x y
} {
272 if {[$w cget
-state] eq
"disabled"} {
276 $w configure
-state active
277 $w set [$w get
$x $y]
279 set Priv
(initValue
) [$w get
]
280 set Priv
($w,relief
) [$w cget
-sliderrelief]