summaryrefslogtreecommitdiffstats
path: root/library/button.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/button.tcl')
-rw-r--r--library/button.tcl290
1 files changed, 145 insertions, 145 deletions
diff --git a/library/button.tcl b/library/button.tcl
index 457b545..763c67e 100644
--- a/library/button.tcl
+++ b/library/button.tcl
@@ -4,7 +4,7 @@
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
-# RCS: @(#) $Id: button.tcl,v 1.10 2000/05/25 17:19:57 ericm Exp $
+# RCS: @(#) $Id: button.tcl,v 1.11 2001/08/01 16:21:11 dgp Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -19,111 +19,111 @@
if {[string match "macintosh" $tcl_platform(platform)]} {
bind Radiobutton <Enter> {
- tkButtonEnter %W
+ tk::ButtonEnter %W
}
bind Radiobutton <1> {
- tkButtonDown %W
+ tk::ButtonDown %W
}
bind Radiobutton <ButtonRelease-1> {
- tkButtonUp %W
+ tk::ButtonUp %W
}
bind Checkbutton <Enter> {
- tkButtonEnter %W
+ tk::ButtonEnter %W
}
bind Checkbutton <1> {
- tkButtonDown %W
+ tk::ButtonDown %W
}
bind Checkbutton <ButtonRelease-1> {
- tkButtonUp %W
+ tk::ButtonUp %W
}
}
if {[string match "windows" $tcl_platform(platform)]} {
bind Checkbutton <equal> {
- tkCheckRadioInvoke %W select
+ tk::CheckRadioInvoke %W select
}
bind Checkbutton <plus> {
- tkCheckRadioInvoke %W select
+ tk::CheckRadioInvoke %W select
}
bind Checkbutton <minus> {
- tkCheckRadioInvoke %W deselect
+ tk::CheckRadioInvoke %W deselect
}
bind Checkbutton <1> {
- tkCheckRadioDown %W
+ tk::CheckRadioDown %W
}
bind Checkbutton <ButtonRelease-1> {
- tkButtonUp %W
+ tk::ButtonUp %W
}
bind Checkbutton <Enter> {
- tkCheckRadioEnter %W
+ tk::CheckRadioEnter %W
}
bind Radiobutton <1> {
- tkCheckRadioDown %W
+ tk::CheckRadioDown %W
}
bind Radiobutton <ButtonRelease-1> {
- tkButtonUp %W
+ tk::ButtonUp %W
}
bind Radiobutton <Enter> {
- tkCheckRadioEnter %W
+ tk::CheckRadioEnter %W
}
}
if {[string match "unix" $tcl_platform(platform)]} {
bind Checkbutton <Return> {
if {!$tk_strictMotif} {
- tkCheckRadioInvoke %W
+ tk::CheckRadioInvoke %W
}
}
bind Radiobutton <Return> {
if {!$tk_strictMotif} {
- tkCheckRadioInvoke %W
+ tk::CheckRadioInvoke %W
}
}
bind Checkbutton <1> {
- tkCheckRadioInvoke %W
+ tk::CheckRadioInvoke %W
}
bind Radiobutton <1> {
- tkCheckRadioInvoke %W
+ tk::CheckRadioInvoke %W
}
bind Checkbutton <Enter> {
- tkButtonEnter %W
+ tk::ButtonEnter %W
}
bind Radiobutton <Enter> {
- tkButtonEnter %W
+ tk::ButtonEnter %W
}
}
bind Button <space> {
- tkButtonInvoke %W
+ tk::ButtonInvoke %W
}
bind Checkbutton <space> {
- tkCheckRadioInvoke %W
+ tk::CheckRadioInvoke %W
}
bind Radiobutton <space> {
- tkCheckRadioInvoke %W
+ tk::CheckRadioInvoke %W
}
bind Button <FocusIn> {}
bind Button <Enter> {
- tkButtonEnter %W
+ tk::ButtonEnter %W
}
bind Button <Leave> {
- tkButtonLeave %W
+ tk::ButtonLeave %W
}
bind Button <1> {
- tkButtonDown %W
+ tk::ButtonDown %W
}
bind Button <ButtonRelease-1> {
- tkButtonUp %W
+ tk::ButtonUp %W
}
bind Checkbutton <FocusIn> {}
bind Checkbutton <Leave> {
- tkButtonLeave %W
+ tk::ButtonLeave %W
}
bind Radiobutton <FocusIn> {}
bind Radiobutton <Leave> {
- tkButtonLeave %W
+ tk::ButtonLeave %W
}
if {[string match "windows" $tcl_platform(platform)]} {
@@ -132,7 +132,7 @@ if {[string match "windows" $tcl_platform(platform)]} {
# Windows implementation
#########################
-# tkButtonEnter --
+# ::tk::ButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget. It records the button we're in and changes the
# state of the button to active unless the button is disabled.
@@ -140,35 +140,35 @@ if {[string match "windows" $tcl_platform(platform)]} {
# Arguments:
# w - The name of the widget.
-proc tkButtonEnter w {
- global tkPriv
+proc ::tk::ButtonEnter w {
+ variable ::tk::Priv
if {[string compare [$w cget -state] "disabled"] } {
# If the mouse button is down, set the relief to sunken on entry.
# Overwise, if there's an -overrelief value, set the relief to that.
- if {[string equal $tkPriv(buttonWindow) $w]} {
+ if {[string equal $Priv(buttonWindow) $w]} {
$w configure -state active -relief sunken
} elseif { [string compare [$w cget -overrelief] ""] } {
- set tkPriv(relief) [$w cget -relief]
+ set Priv(relief) [$w cget -relief]
$w configure -relief [$w cget -overrelief]
}
}
- set tkPriv(window) $w
+ set Priv(window) $w
}
-# tkButtonLeave --
+# ::tk::ButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget. It changes the state of the button back to
# inactive. If we're leaving the button window with a mouse button
-# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# pressed (Priv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w - The name of the widget.
-proc tkButtonLeave w {
- global tkPriv
+proc ::tk::ButtonLeave w {
+ variable ::tk::Priv
if {[string compare [$w cget -state] "disabled"]} {
$w configure -state normal
}
@@ -176,15 +176,15 @@ proc tkButtonLeave w {
# Restore the original button relief if the mouse button is down
# or there is an -overrelief value.
- if {[string equal $tkPriv(buttonWindow) $w] || \
+ if {[string equal $Priv(buttonWindow) $w] || \
[string compare [$w cget -overrelief] ""] } {
- $w configure -relief $tkPriv(relief)
+ $w configure -relief $Priv(relief)
}
- set tkPriv(window) ""
+ set Priv(window) ""
}
-# tkCheckRadioEnter --
+# ::tk::CheckRadioEnter --
# The procedure below is invoked when the mouse pointer enters a
# checkbutton or radiobutton widget. It records the button we're in
# and changes the state of the button to active unless the button is
@@ -193,21 +193,21 @@ proc tkButtonLeave w {
# Arguments:
# w - The name of the widget.
-proc tkCheckRadioEnter w {
- global tkPriv
+proc ::tk::CheckRadioEnter w {
+ variable ::tk::Priv
if {[string compare [$w cget -state] "disabled"]} {
- if {[string equal $tkPriv(buttonWindow) $w]} {
+ if {[string equal $Priv(buttonWindow) $w]} {
$w configure -state active
}
if { [string compare [$w cget -overrelief] ""] } {
- set tkPriv(relief) [$w cget -relief]
+ set Priv(relief) [$w cget -relief]
$w configure -relief [$w cget -overrelief]
}
}
- set tkPriv(window) $w
+ set Priv(window) $w
}
-# tkButtonDown --
+# ::tk::ButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget. It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
@@ -216,31 +216,31 @@ proc tkCheckRadioEnter w {
# Arguments:
# w - The name of the widget.
-proc tkButtonDown w {
- global tkPriv
+proc ::tk::ButtonDown w {
+ variable ::tk::Priv
# Only save the button's relief if it has no -overrelief value. If there
- # is an overrelief setting, tkPriv(relief) will already have been set, and
+ # is an overrelief setting, Priv(relief) will already have been set, and
# the current value of the -relief option will be incorrect.
if { [string equal [$w cget -overrelief] ""] } {
- set tkPriv(relief) [$w cget -relief]
+ set Priv(relief) [$w cget -relief]
}
if {[string compare [$w cget -state] "disabled"]} {
- set tkPriv(buttonWindow) $w
+ set Priv(buttonWindow) $w
$w configure -relief sunken -state active
# If this button has a repeatdelay set up, get it going with an after
- after cancel $tkPriv(afterId)
+ after cancel $Priv(afterId)
set delay [$w cget -repeatdelay]
- set tkPriv(repeated) 0
+ set Priv(repeated) 0
if {$delay > 0} {
- set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]]
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
}
-# tkCheckRadioDown --
+# ::tk::CheckRadioDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget. It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
@@ -249,19 +249,19 @@ proc tkButtonDown w {
# Arguments:
# w - The name of the widget.
-proc tkCheckRadioDown w {
- global tkPriv
+proc ::tk::CheckRadioDown w {
+ variable ::tk::Priv
if { [string equal [$w cget -overrelief] ""] } {
- set tkPriv(relief) [$w cget -relief]
+ set Priv(relief) [$w cget -relief]
}
if {[string compare [$w cget -state] "disabled"]} {
- set tkPriv(buttonWindow) $w
- set tkPriv(repeated) 0
+ set Priv(buttonWindow) $w
+ set Priv(repeated) 0
$w configure -state active
}
}
-# tkButtonUp --
+# ::tk::ButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget. It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
@@ -269,10 +269,10 @@ proc tkCheckRadioDown w {
# Arguments:
# w - The name of the widget.
-proc tkButtonUp w {
- global tkPriv
- if {[string equal $tkPriv(buttonWindow) $w]} {
- set tkPriv(buttonWindow) ""
+proc ::tk::ButtonUp w {
+ variable ::tk::Priv
+ if {[string equal $Priv(buttonWindow) $w]} {
+ set Priv(buttonWindow) ""
# Restore the button's relief. If there is no overrelief, the
# button relief goes back to its original value. If there is an
# overrelief, the relief goes to the overrelief (since the cursor is
@@ -280,21 +280,21 @@ proc tkButtonUp w {
set relief [$w cget -overrelief]
if { [string equal $relief ""] } {
- set relief $tkPriv(relief)
+ set relief $Priv(relief)
}
$w configure -relief $relief
# Clean up the after event from the auto-repeater
- after cancel $tkPriv(afterId)
+ after cancel $Priv(afterId)
- if {[string equal $tkPriv(window) $w]
+ if {[string equal $Priv(window) $w]
&& [string compare [$w cget -state] "disabled"]} {
$w configure -state normal
# Only invoke the command if it wasn't already invoked by the
# auto-repeater functionality
- if { $tkPriv(repeated) == 0 } {
+ if { $Priv(repeated) == 0 } {
uplevel #0 [list $w invoke]
}
}
@@ -309,7 +309,7 @@ if {[string match "unix" $tcl_platform(platform)]} {
# Unix implementation
#####################
-# tkButtonEnter --
+# ::tk::ButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget. It records the button we're in and changes the
# state of the button to active unless the button is disabled.
@@ -317,37 +317,37 @@ if {[string match "unix" $tcl_platform(platform)]} {
# Arguments:
# w - The name of the widget.
-proc tkButtonEnter {w} {
- global tkPriv
+proc ::tk::ButtonEnter {w} {
+ variable ::tk::Priv
if {[string compare [$w cget -state] "disabled"]} {
$w configure -state active
# If the mouse button is down, set the relief to sunken on entry.
# Overwise, if there's an -overrelief value, set the relief to that.
- if {[string equal $tkPriv(buttonWindow) $w]} {
+ if {[string equal $Priv(buttonWindow) $w]} {
$w configure -state active -relief sunken
} elseif { [string compare [$w cget -overrelief] ""] } {
- set tkPriv(relief) [$w cget -relief]
+ set Priv(relief) [$w cget -relief]
$w configure -relief [$w cget -overrelief]
}
}
- set tkPriv(window) $w
+ set Priv(window) $w
}
-# tkButtonLeave --
+# ::tk::ButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget. It changes the state of the button back to
# inactive. If we're leaving the button window with a mouse button
-# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# pressed (Priv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w - The name of the widget.
-proc tkButtonLeave w {
- global tkPriv
+proc ::tk::ButtonLeave w {
+ variable ::tk::Priv
if {[string compare [$w cget -state] "disabled"]} {
$w configure -state normal
}
@@ -355,15 +355,15 @@ proc tkButtonLeave w {
# Restore the original button relief if the mouse button is down
# or there is an -overrelief value.
- if {[string equal $tkPriv(buttonWindow) $w] || \
+ if {[string equal $Priv(buttonWindow) $w] || \
[string compare [$w cget -overrelief] ""] } {
- $w configure -relief $tkPriv(relief)
+ $w configure -relief $Priv(relief)
}
- set tkPriv(window) ""
+ set Priv(window) ""
}
-# tkButtonDown --
+# ::tk::ButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget. It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
@@ -372,32 +372,32 @@ proc tkButtonLeave w {
# Arguments:
# w - The name of the widget.
-proc tkButtonDown w {
- global tkPriv
+proc ::tk::ButtonDown w {
+ variable ::tk::Priv
# Only save the button's relief if it has no -overrelief value. If there
- # is an overrelief setting, tkPriv(relief) will already have been set, and
+ # is an overrelief setting, Priv(relief) will already have been set, and
# the current value of the -relief option will be incorrect.
if { [string equal [$w cget -overrelief] ""] } {
- set tkPriv(relief) [$w cget -relief]
+ set Priv(relief) [$w cget -relief]
}
if {[string compare [$w cget -state] "disabled"]} {
- set tkPriv(buttonWindow) $w
+ set Priv(buttonWindow) $w
$w configure -relief sunken
# If this button has a repeatdelay set up, get it going with an after
- after cancel $tkPriv(afterId)
+ after cancel $Priv(afterId)
set delay [$w cget -repeatdelay]
- set tkPriv(repeated) 0
+ set Priv(repeated) 0
if {$delay > 0} {
- set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]]
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
}
-# tkButtonUp --
+# ::tk::ButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget. It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
@@ -405,10 +405,10 @@ proc tkButtonDown w {
# Arguments:
# w - The name of the widget.
-proc tkButtonUp w {
- global tkPriv
- if {[string equal $w $tkPriv(buttonWindow)]} {
- set tkPriv(buttonWindow) ""
+proc ::tk::ButtonUp w {
+ variable ::tk::Priv
+ if {[string equal $w $Priv(buttonWindow)]} {
+ set Priv(buttonWindow) ""
# Restore the button's relief. If there is no overrelief, the
# button relief goes back to its original value. If there is an
@@ -417,19 +417,19 @@ proc tkButtonUp w {
set relief [$w cget -overrelief]
if { [string equal $relief ""] } {
- set relief $tkPriv(relief)
+ set relief $Priv(relief)
}
$w configure -relief $relief
# Clean up the after event from the auto-repeater
- after cancel $tkPriv(afterId)
+ after cancel $Priv(afterId)
- if {[string equal $w $tkPriv(window)] \
+ if {[string equal $w $Priv(window)] \
&& [string compare [$w cget -state] "disabled"]} {
# Only invoke the command if it wasn't already invoked by the
# auto-repeater functionality
- if { $tkPriv(repeated) == 0 } {
+ if { $Priv(repeated) == 0 } {
uplevel #0 [list $w invoke]
}
}
@@ -444,7 +444,7 @@ if {[string match "macintosh" $tcl_platform(platform)]} {
# Mac implementation
####################
-# tkButtonEnter --
+# ::tk::ButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget. It records the button we're in and changes the
# state of the button to active unless the button is disabled.
@@ -452,41 +452,41 @@ if {[string match "macintosh" $tcl_platform(platform)]} {
# Arguments:
# w - The name of the widget.
-proc tkButtonEnter {w} {
- global tkPriv
+proc ::tk::ButtonEnter {w} {
+ variable ::tk::Priv
if {[string compare [$w cget -state] "disabled"]} {
- if {[string equal $w $tkPriv(buttonWindow)]} {
+ if {[string equal $w $Priv(buttonWindow)]} {
$w configure -state active
} elseif { [string compare [$w cget -overrelief] ""] } {
- set tkPriv(relief) [$w cget -relief]
+ set Priv(relief) [$w cget -relief]
$w configure -relief [$w cget -overrelief]
}
}
- set tkPriv(window) $w
+ set Priv(window) $w
}
-# tkButtonLeave --
+# ::tk::ButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget. It changes the state of the button back to
# inactive. If we're leaving the button window with a mouse button
-# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# pressed (Priv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w - The name of the widget.
-proc tkButtonLeave w {
- global tkPriv
- if {[string equal $w $tkPriv(buttonWindow)]} {
+proc ::tk::ButtonLeave w {
+ variable ::tk::Priv
+ if {[string equal $w $Priv(buttonWindow)]} {
$w configure -state normal
}
if { [string compare [$w cget -overrelief] ""] } {
- $w configure -relief $tkPriv(relief)
+ $w configure -relief $Priv(relief)
}
- set tkPriv(window) ""
+ set Priv(window) ""
}
-# tkButtonDown --
+# ::tk::ButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget. It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
@@ -495,26 +495,26 @@ proc tkButtonLeave w {
# Arguments:
# w - The name of the widget.
-proc tkButtonDown w {
- global tkPriv
+proc ::tk::ButtonDown w {
+ variable ::tk::Priv
if {[string compare [$w cget -state] "disabled"]} {
- set tkPriv(buttonWindow) $w
+ set Priv(buttonWindow) $w
$w configure -state active
# If this button has a repeatdelay set up, get it going with an after
- after cancel $tkPriv(afterId)
+ after cancel $Priv(afterId)
if { ![catch {$w cget -repeatdelay} delay] } {
set delay [$w cget -repeatdelay]
- set tkPriv(repeated) 0
+ set Priv(repeated) 0
if {$delay > 0} {
- set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]]
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
}
}
-# tkButtonUp --
+# ::tk::ButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget. It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
@@ -522,24 +522,24 @@ proc tkButtonDown w {
# Arguments:
# w - The name of the widget.
-proc tkButtonUp w {
- global tkPriv
- if {[string equal $w $tkPriv(buttonWindow)]} {
+proc ::tk::ButtonUp w {
+ variable ::tk::Priv
+ if {[string equal $w $Priv(buttonWindow)]} {
$w configure -state normal
- set tkPriv(buttonWindow) ""
+ set Priv(buttonWindow) ""
if { [string compare [$w cget -overrelief] ""] } {
$w configure -relief [$w cget -overrelief]
}
# Clean up the after event from the auto-repeater
- after cancel $tkPriv(afterId)
+ after cancel $Priv(afterId)
- if {[string equal $w $tkPriv(window)]
+ if {[string equal $w $Priv(window)]
&& [string compare [$w cget -state] "disabled"]} {
# Only invoke the command if it wasn't already invoked by the
# auto-repeater functionality
- if { $tkPriv(repeated) == 0 } {
+ if { $Priv(repeated) == 0 } {
uplevel #0 [list $w invoke]
}
}
@@ -552,14 +552,14 @@ proc tkButtonUp w {
# Shared routines
##################
-# tkButtonInvoke --
+# ::tk::ButtonInvoke --
# The procedure below is called when a button is invoked through
# the keyboard. It simulate a press of the button via the mouse.
#
# Arguments:
# w - The name of the widget.
-proc tkButtonInvoke w {
+proc ::tk::ButtonInvoke w {
if {[string compare [$w cget -state] "disabled"]} {
set oldRelief [$w cget -relief]
set oldState [$w cget -state]
@@ -571,7 +571,7 @@ proc tkButtonInvoke w {
}
}
-# tkButtonAutoInvoke --
+# ::tk::ButtonAutoInvoke --
#
# Invoke an auto-repeating button, and set it up to continue to repeat.
#
@@ -582,22 +582,22 @@ proc tkButtonInvoke w {
# None.
#
# Side effects:
-# May create an after event to call tkButtonAutoInvoke.
+# May create an after event to call ::tk::ButtonAutoInvoke.
-proc tkButtonAutoInvoke {w} {
- global tkPriv
- after cancel $tkPriv(afterId)
+proc ::tk::ButtonAutoInvoke {w} {
+ variable ::tk::Priv
+ after cancel $Priv(afterId)
set delay [$w cget -repeatinterval]
- if { [string equal $tkPriv(window) $w] } {
- incr tkPriv(repeated)
+ if { [string equal $Priv(window) $w] } {
+ incr Priv(repeated)
uplevel #0 [list $w invoke]
}
if {$delay > 0} {
- set tkPriv(afterId) [after $delay [list tkButtonAutoInvoke $w]]
+ set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]
}
}
-# tkCheckRadioInvoke --
+# ::tk::CheckRadioInvoke --
# The procedure below is invoked when the mouse button is pressed in
# a checkbutton or radiobutton widget, or when the widget is invoked
# through the keyboard. It invokes the widget if it
@@ -607,7 +607,7 @@ proc tkButtonAutoInvoke {w} {
# w - The name of the widget.
# cmd - The subcommand to invoke (one of invoke, select, or deselect).
-proc tkCheckRadioInvoke {w {cmd invoke}} {
+proc ::tk::CheckRadioInvoke {w {cmd invoke}} {
if {[string compare [$w cget -state] "disabled"]} {
uplevel #0 [list $w $cmd]
}
generated by cgit v0.12 at 2024-07-01 00:20:52 (GMT)