# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
# RCS: @(#) $Id: scale.tcl,v 1.9.2.3 2003/10/03 00:42:17 patthoyts Exp $
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 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 entries.
#-------------------------------------------------------------------------
# Standard Motif bindings:
set tk::Priv(activeBg
) [%W cget
-activebackground]
%W config
-activebackground [%W cget
-background]
tk::ScaleActivate %W
%x
%y
tk::ScaleActivate %W
%x
%y
%W config
-activebackground $tk::Priv(activeBg
)
if {[string equal
[%W cget
-state] "active"]} {
%W configure
-state normal
tk::ScaleButtonDown %W
%x
%y
bind Scale
<B1-Leave
> { }
bind Scale
<B1-Enter
> { }
bind Scale
<ButtonRelease-1
> {
tk::ScaleActivate %W
%x
%y
tk::ScaleButton2Down %W
%x
%y
bind Scale
<B2-Leave
> { }
bind Scale
<B2-Enter
> { }
bind Scale
<ButtonRelease-2
> {
tk::ScaleActivate %W
%x
%y
if {[string equal
$tcl_platform(platform
) "windows"]} {
# On Windows do the same with button 3, as that is the right mouse button
bind Scale
<3> [bind Scale
<2>]
bind Scale
<B3-Motion
> [bind Scale
<B2-Motion
>]
bind Scale
<B3-Leave
> [bind Scale
<B2-Leave
>]
bind Scale
<B3-Enter
> [bind Scale
<B2-Enter
>]
bind Scale
<ButtonRelease-3
> [bind Scale
<ButtonRelease-2
>]
tk::ScaleControlPress %W
%x
%y
tk::ScaleIncrement %W up little noRepeat
tk::ScaleIncrement %W down little noRepeat
tk::ScaleIncrement %W up little noRepeat
tk::ScaleIncrement %W down little noRepeat
bind Scale
<Control-Up
> {
tk::ScaleIncrement %W up big noRepeat
bind Scale
<Control-Down
> {
tk::ScaleIncrement %W down big noRepeat
bind Scale
<Control-Left
> {
tk::ScaleIncrement %W up big noRepeat
bind Scale
<Control-Right
> {
tk::ScaleIncrement %W down big noRepeat
# This procedure is invoked to check a given x-y position in the
# scale and activate the slider if the x-y position falls within
# x, y - Mouse coordinates.
proc ::tk::ScaleActivate {w x y
} {
if {[string equal
[$w cget
-state] "disabled"]} {
if {[string equal
[$w identify
$x $y] "slider"]} {
if {[string compare
[$w cget
-state] $state]} {
$w configure
-state $state
# ::tk::ScaleButtonDown --
# This procedure is invoked when a button is pressed in a scale. It
# takes different actions depending on where the button was pressed.
# x, y - Mouse coordinates of button press.
proc ::tk::ScaleButtonDown {w x y
} {
set el
[$w identify
$x $y]
set Priv
($w,relief
) [$w cget
-sliderrelief]
if {[string equal
$el "trough1"]} {
ScaleIncrement
$w up little initial
} elseif
{[string equal
$el "trough2"]} {
ScaleIncrement
$w down little initial
} elseif
{[string equal
$el "slider"]} {
set Priv
(initValue
) [$w get
]
set Priv
(deltaX
) [expr {$x - [lindex $coords 0]}]
set Priv
(deltaY
) [expr {$y - [lindex $coords 1]}]
switch -exact -- $Priv($w,relief
) {
"raised" { $w configure
-sliderrelief sunken
}
"ridge" { $w configure
-sliderrelief groove
}
# This procedure is called when the mouse is dragged with
# mouse button 1 down. If the drag started inside the slider
# (i.e. the scale is active) then the scale's value is adjusted
# to reflect the mouse's position.
# x, y - Mouse coordinates.
proc ::tk::ScaleDrag {w x y
} {
$w set [$w get
[expr {$x-$Priv(deltaX
)}] [expr {$y-$Priv(deltaY
)}]]
# This procedure is called to end an interactive drag of the
# slider. It just marks the drag as over.
proc ::tk::ScaleEndDrag {w
} {
if {[info exists Priv
($w,relief
)]} {
$w configure
-sliderrelief $Priv($w,relief
)
# ::tk::ScaleIncrement --
# This procedure is invoked to increment the value of a scale and
# to set up auto-repeating of the action if that is desired. The
# way the value is incremented depends on the "dir" and "big"
# dir - "up" means move value towards -from, "down" means
# big - Size of increments: "big" or "little".
# 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::ScaleIncrement {w dir big repeat
} {
if {![winfo exists
$w]} return
if {[string equal
$big "big"]} {
set inc
[$w cget
-bigincrement]
set inc
[expr {abs
([$w cget
-to] - [$w cget
-from])/10.0}]
if {$inc < [$w cget
-resolution]} {
set inc
[$w cget
-resolution]
set inc
[$w cget
-resolution]
if {([$w cget
-from] > [$w cget
-to]) ^
[string equal
$dir "up"]} {
$w set [expr {[$w get
] + $inc}]
if {[string equal
$repeat "again"]} {
set Priv
(afterId
) [after [$w cget
-repeatinterval] \
[list tk::ScaleIncrement $w $dir $big again
]]
} elseif
{[string equal
$repeat "initial"]} {
set delay
[$w cget
-repeatdelay]
set Priv
(afterId
) [after $delay \
[list tk::ScaleIncrement $w $dir $big again
]]
# ::tk::ScaleControlPress --
# This procedure handles button presses that are made with the Control
# key down. Depending on the mouse position, it adjusts the scale
# value to one end of the range or the other.
# x, y - Mouse coordinates where the button was pressed.
proc ::tk::ScaleControlPress {w x y
} {
set el
[$w identify
$x $y]
if {[string equal
$el "trough1"]} {
} elseif
{[string equal
$el "trough2"]} {
# This procedure is invoked when button 2 is pressed over a scale.
# It sets the value to correspond to the mouse position and starts
# w - The scrollbar widget.
# x, y - Mouse coordinates within the widget.
proc ::tk::ScaleButton2Down {w x y
} {
if {[string equal
[$w cget
-state] "disabled"]} {
$w configure
-state active
set Priv
(initValue
) [$w get
]
set Priv
($w,relief
) [$w cget
-sliderrelief]