[OpenSPARC-T2-SAM] / sam-t2 / devtools / amd64 / lib / tk8.4 / scale.tcl

# scale.tcl --
#
# 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:

bind Scale <Enter> {
    if {$tk_strictMotif} {
	set tk::Priv(activeBg) [%W cget -activebackground]
	%W config -activebackground [%W cget -background]
    }
    tk::ScaleActivate %W %x %y
}
bind Scale <Motion> {
    tk::ScaleActivate %W %x %y
}
bind Scale <Leave> {
    if {$tk_strictMotif} {
	%W config -activebackground $tk::Priv(activeBg)
    }
    if {[string equal [%W cget -state] "active"]} {
	%W configure -state normal
    }
}
bind Scale <1> {
    tk::ScaleButtonDown %W %x %y
}
bind Scale <B1-Motion> {
    tk::ScaleDrag %W %x %y
}
bind Scale <B1-Leave> { }
bind Scale <B1-Enter> { }
bind Scale <ButtonRelease-1> {
    tk::CancelRepeat
    tk::ScaleEndDrag %W
    tk::ScaleActivate %W %x %y
}
bind Scale <2> {
    tk::ScaleButton2Down %W %x %y
}
bind Scale <B2-Motion> {
    tk::ScaleDrag %W %x %y
}
bind Scale <B2-Leave> { }
bind Scale <B2-Enter> { }
bind Scale <ButtonRelease-2> {
    tk::CancelRepeat
    tk::ScaleEndDrag %W
    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>]
}
bind Scale <Control-1> {
    tk::ScaleControlPress %W %x %y
}
bind Scale <Up> {
    tk::ScaleIncrement %W up little noRepeat
}
bind Scale <Down> {
    tk::ScaleIncrement %W down little noRepeat
}
bind Scale <Left> {
    tk::ScaleIncrement %W up little noRepeat
}
bind Scale <Right> {
    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
}
bind Scale <Home> {
    %W set [%W cget -from]
}
bind Scale <End> {
    %W set [%W cget -to]
}

# ::tk::ScaleActivate --
# 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
# the slider.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates.

proc ::tk::ScaleActivate {w x y} {
    if {[string equal [$w cget -state] "disabled"]} {
	return
    }
    if {[string equal [$w identify $x $y] "slider"]} {
	set state active
    } else {
	set state normal
    }
    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.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates of button press.

proc ::tk::ScaleButtonDown {w x y} {
    variable ::tk::Priv
    set Priv(dragging) 0
    set el [$w identify $x $y]

    # save the relief
    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(dragging) 1
	set Priv(initValue) [$w get]
	set coords [$w coords]
	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 }
        }
    }
}

# ::tk::ScaleDrag --
# 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.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates.

proc ::tk::ScaleDrag {w x y} {
    variable ::tk::Priv
    if {!$Priv(dragging)} {
	return
    }
    $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]
}

# ::tk::ScaleEndDrag --
# This procedure is called to end an interactive drag of the
# slider.  It just marks the drag as over.
#
# Arguments:
# w -		The scale widget.

proc ::tk::ScaleEndDrag {w} {
    variable ::tk::Priv
    set Priv(dragging) 0
    if {[info exists Priv($w,relief)]} {
        $w configure -sliderrelief $Priv($w,relief)
        unset 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"
# arguments.
#
# Arguments:
# w -		The scale widget.
# dir -		"up" means move value towards -from, "down" means
#		move towards -to.
# 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} {
    variable ::tk::Priv
    if {![winfo exists $w]} return
    if {[string equal $big "big"]} {
	set inc [$w cget -bigincrement]
	if {$inc == 0} {
	    set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
	}
	if {$inc < [$w cget -resolution]} {
	    set inc [$w cget -resolution]
	}
    } else {
	set inc [$w cget -resolution]
    }
    if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} {
	set inc [expr {-$inc}]
    }
    $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]
	if {$delay > 0} {
	    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.
#
# Arguments:
# w -		The scale widget.
# 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"]} {
	$w set [$w cget -from]
    } elseif {[string equal $el "trough2"]} {
	$w set [$w cget -to]
    }
}

# ::tk::ScaleButton2Down
# This procedure is invoked when button 2 is pressed over a scale.
# It sets the value to correspond to the mouse position and starts
# a slider drag.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

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

    if {[string equal [$w cget -state] "disabled"]} {
      return
    }
    $w configure -state active
    $w set [$w get $x $y]
    set Priv(dragging) 1
    set Priv(initValue) [$w get]
    set Priv($w,relief) [$w cget -sliderrelief]
    set coords "$x $y"
    set Priv(deltaX) 0
    set Priv(deltaY) 0
}
Commit	Line	Data
920dae64 AT	1	# scale.tcl --
	2	#
	3	# This file defines the default bindings for Tk scale widgets and provides
	4	# procedures that help in implementing the bindings.
	5	#
	6	# RCS: @(#) $Id: scale.tcl,v 1.9.2.3 2003/10/03 00:42:17 patthoyts Exp $
	7	#
	8	# Copyright (c) 1994 The Regents of the University of California.
	9	# Copyright (c) 1994-1995 Sun Microsystems, Inc.
	10	#
	11	# See the file "license.terms" for information on usage and redistribution
	12	# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
	13	#
	14
	15	#-------------------------------------------------------------------------
	16	# The code below creates the default class bindings for entries.
	17	#-------------------------------------------------------------------------
	18
	19	# Standard Motif bindings:
	20
	21	bind Scale <Enter> {
	22	if {$tk_strictMotif} {
	23	set tk::Priv(activeBg) [%W cget -activebackground]
	24	%W config -activebackground [%W cget -background]
	25	}
	26	tk::ScaleActivate %W %x %y
	27	}
	28	bind Scale <Motion> {
	29	tk::ScaleActivate %W %x %y
	30	}
	31	bind Scale <Leave> {
	32	if {$tk_strictMotif} {
	33	%W config -activebackground $tk::Priv(activeBg)
	34	}
	35	if {[string equal [%W cget -state] "active"]} {
	36	%W configure -state normal
	37	}
	38	}
	39	bind Scale <1> {
	40	tk::ScaleButtonDown %W %x %y
	41	}
	42	bind Scale <B1-Motion> {
	43	tk::ScaleDrag %W %x %y
	44	}
	45	bind Scale <B1-Leave> { }
	46	bind Scale <B1-Enter> { }
	47	bind Scale <ButtonRelease-1> {
	48	tk::CancelRepeat
	49	tk::ScaleEndDrag %W
	50	tk::ScaleActivate %W %x %y
	51	}
	52	bind Scale <2> {
	53	tk::ScaleButton2Down %W %x %y
	54	}
	55	bind Scale <B2-Motion> {
	56	tk::ScaleDrag %W %x %y
	57	}
	58	bind Scale <B2-Leave> { }
	59	bind Scale <B2-Enter> { }
	60	bind Scale <ButtonRelease-2> {
	61	tk::CancelRepeat
	62	tk::ScaleEndDrag %W
	63	tk::ScaleActivate %W %x %y
	64	}
65	if {[string equal $tcl_platform(platform) "windows"]} {
66	# On Windows do the same with button 3, as that is the right mouse button
67	bind Scale <3> [bind Scale <2>]
68	bind Scale <B3-Motion> [bind Scale <B2-Motion>]
69	bind Scale <B3-Leave> [bind Scale <B2-Leave>]
70	bind Scale <B3-Enter> [bind Scale <B2-Enter>]
71	bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
72	}
73	bind Scale <Control-1> {
74	tk::ScaleControlPress %W %x %y
75	}
76	bind Scale <Up> {
77	tk::ScaleIncrement %W up little noRepeat
78	}
79	bind Scale <Down> {
80	tk::ScaleIncrement %W down little noRepeat
81	}
82	bind Scale <Left> {
83	tk::ScaleIncrement %W up little noRepeat
84	}
85	bind Scale <Right> {
86	tk::ScaleIncrement %W down little noRepeat
87	}
88	bind Scale <Control-Up> {
89	tk::ScaleIncrement %W up big noRepeat
90	}
91	bind Scale <Control-Down> {
92	tk::ScaleIncrement %W down big noRepeat
93	}
94	bind Scale <Control-Left> {
95	tk::ScaleIncrement %W up big noRepeat
96	}
97	bind Scale <Control-Right> {
98	tk::ScaleIncrement %W down big noRepeat
99	}
100	bind Scale <Home> {
101	%W set [%W cget -from]
102	}
103	bind Scale <End> {
104	%W set [%W cget -to]
105	}
106
107	# ::tk::ScaleActivate --
108	# This procedure is invoked to check a given x-y position in the
109	# scale and activate the slider if the x-y position falls within
110	# the slider.
111	#
112	# Arguments:
113	# w - The scale widget.
114	# x, y - Mouse coordinates.
115
116	proc ::tk::ScaleActivate {w x y} {
117	if {[string equal [$w cget -state] "disabled"]} {
118	return
119	}
120	if {[string equal [$w identify $x $y] "slider"]} {
121	set state active
122	} else {
123	set state normal
124	}
125	if {[string compare [$w cget -state] $state]} {
126	$w configure -state $state
127	}
128	}
129
130	# ::tk::ScaleButtonDown --
131	# This procedure is invoked when a button is pressed in a scale. It
132	# takes different actions depending on where the button was pressed.
133	#
134	# Arguments:
135	# w - The scale widget.
136	# x, y - Mouse coordinates of button press.
137
138	proc ::tk::ScaleButtonDown {w x y} {
139	variable ::tk::Priv
140	set Priv(dragging) 0
141	set el [$w identify $x $y]
142
143	# save the relief
144	set Priv($w,relief) [$w cget -sliderrelief]
145
146	if {[string equal $el "trough1"]} {
147	ScaleIncrement $w up little initial
148	} elseif {[string equal $el "trough2"]} {
149	ScaleIncrement $w down little initial
150	} elseif {[string equal $el "slider"]} {
151	set Priv(dragging) 1
152	set Priv(initValue) [$w get]
153	set coords [$w coords]
154	set Priv(deltaX) [expr {$x - [lindex $coords 0]}]
155	set Priv(deltaY) [expr {$y - [lindex $coords 1]}]
156	switch -exact -- $Priv($w,relief) {
157	"raised" { $w configure -sliderrelief sunken }
158	"ridge" { $w configure -sliderrelief groove }
159	}
160	}
161	}
162
163	# ::tk::ScaleDrag --
164	# This procedure is called when the mouse is dragged with
165	# mouse button 1 down. If the drag started inside the slider
166	# (i.e. the scale is active) then the scale's value is adjusted
167	# to reflect the mouse's position.
168	#
169	# Arguments:
170	# w - The scale widget.
171	# x, y - Mouse coordinates.
172
173	proc ::tk::ScaleDrag {w x y} {
174	variable ::tk::Priv
175	if {!$Priv(dragging)} {
176	return
177	}
178	$w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]
179	}
180
181	# ::tk::ScaleEndDrag --
182	# This procedure is called to end an interactive drag of the
183	# slider. It just marks the drag as over.
184	#
185	# Arguments:
186	# w - The scale widget.
187
188	proc ::tk::ScaleEndDrag {w} {
189	variable ::tk::Priv
190	set Priv(dragging) 0
191	if {[info exists Priv($w,relief)]} {
192	$w configure -sliderrelief $Priv($w,relief)
193	unset Priv($w,relief)
194	}
195	}
196
197	# ::tk::ScaleIncrement --
198	# This procedure is invoked to increment the value of a scale and
199	# to set up auto-repeating of the action if that is desired. The
200	# way the value is incremented depends on the "dir" and "big"
201	# arguments.
202	#
203	# Arguments:
204	# w - The scale widget.
205	# dir - "up" means move value towards -from, "down" means
206	# move towards -to.
207	# big - Size of increments: "big" or "little".
208	# repeat - Whether and how to auto-repeat the action: "noRepeat"
209	# means don't auto-repeat, "initial" means this is the
210	# first action in an auto-repeat sequence, and "again"
211	# means this is the second repetition or later.
212
213	proc ::tk::ScaleIncrement {w dir big repeat} {
214	variable ::tk::Priv
215	if {![winfo exists $w]} return
216	if {[string equal $big "big"]} {
217	set inc [$w cget -bigincrement]
218	if {$inc == 0} {
219	set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
220	}
221	if {$inc < [$w cget -resolution]} {
222	set inc [$w cget -resolution]
223	}
224	} else {
225	set inc [$w cget -resolution]
226	}
227	if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} {
228	set inc [expr {-$inc}]
229	}
230	$w set [expr {[$w get] + $inc}]
231
232	if {[string equal $repeat "again"]} {
233	set Priv(afterId) [after [$w cget -repeatinterval] \
234	[list tk::ScaleIncrement $w $dir $big again]]
235	} elseif {[string equal $repeat "initial"]} {
236	set delay [$w cget -repeatdelay]
237	if {$delay > 0} {
238	set Priv(afterId) [after $delay \
239	[list tk::ScaleIncrement $w $dir $big again]]
240	}
241	}
242	}
243
244	# ::tk::ScaleControlPress --
245	# This procedure handles button presses that are made with the Control
246	# key down. Depending on the mouse position, it adjusts the scale
247	# value to one end of the range or the other.
248	#
249	# Arguments:
250	# w - The scale widget.
251	# x, y - Mouse coordinates where the button was pressed.
252
253	proc ::tk::ScaleControlPress {w x y} {
254	set el [$w identify $x $y]
255	if {[string equal $el "trough1"]} {
256	$w set [$w cget -from]
257	} elseif {[string equal $el "trough2"]} {
258	$w set [$w cget -to]
259	}
260	}
261
262	# ::tk::ScaleButton2Down
263	# This procedure is invoked when button 2 is pressed over a scale.
264	# It sets the value to correspond to the mouse position and starts
265	# a slider drag.
266	#
267	# Arguments:
268	# w - The scrollbar widget.
269	# x, y - Mouse coordinates within the widget.
270
271	proc ::tk::ScaleButton2Down {w x y} {
272	variable ::tk::Priv
273
274	if {[string equal [$w cget -state] "disabled"]} {
275	return
276	}
277	$w configure -state active
278	$w set [$w get $x $y]
279	set Priv(dragging) 1
280	set Priv(initValue) [$w get]
281	set Priv($w,relief) [$w cget -sliderrelief]
282	set coords "$x $y"
283	set Priv(deltaX) 0
284	set Priv(deltaY) 0
285	}