/usr/share/saods9/blt3.0/unixButton.tcl is in saods9-blt 7.2+dfsg-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | #####################
# Unix implementation
#####################
bind TkCheckbutton <Return> {
if {!$tk_strictMotif} {
blt::Button::CheckRadioInvoke %W
}
}
bind TkRadiobutton <Return> {
if {!$tk_strictMotif} {
blt::Button::CheckRadioInvoke %W
}
}
bind TkPushbutton <Return> {
if {!$tk_strictMotif} {
blt::Button::CheckRadioInvoke %W
}
}
bind TkCheckbutton <1> {
blt::Button::CheckRadioInvoke %W
}
bind TkRadiobutton <1> {
blt::Button::CheckRadioInvoke %W
}
bind TkPushbutton <1> {
blt::Button::CheckRadioInvoke %W
}
bind TkCheckbutton <Enter> {
blt::Button::Enter %W
}
bind TkRadiobutton <Enter> {
blt::Button::Enter %W
}
bind TkPushbutton <Enter> {
blt::Button::Enter %W
}
# Enter --
#
# 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.
#
# Arguments:
# w - The name of the widget.
proc ::blt::Button::Enter {w} {
variable _private
if { [$w cget -state] != "disabled" } {
# On unix the state is active just with mouse-over
$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.
set _private($w,relief) [$w cget -relief]
if {$_private(buttonWindow) eq $w} {
$w configure -relief sunken
set _private($w,prelief) sunken
} elseif {[set over [$w cget -overrelief]] ne ""} {
$w configure -relief $over
set _private($w,prelief) $over
}
}
set _private(window) $w
}
# Leave --
#
# The procedure below is invoked when the mouse pointer leaves a
# button widget. It changes the state of the button back to inactive.
# Restore any modified relief too.
#
# Arguments:
# w - The name of the widget.
proc ::blt::Button::Leave w {
variable _private
if {[$w cget -state] != "disabled"} {
$w configure -state normal
}
# Restore the original button relief if it was changed by Tk.
# That is signaled by the existence of _private($w,prelief).
if {[info exists _private($w,relief)]} {
if {[info exists _private($w,prelief)] && \
$_private($w,prelief) eq [$w cget -relief]} {
$w configure -relief $_private($w,relief)
}
unset -nocomplain _private($w,relief) _private($w,prelief)
}
set _private(window) ""
}
# Down --
#
# 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
# the relief to sunken.
#
# Arguments:
# w - The name of the widget.
proc ::blt::Button::Down w {
variable _private
# Only save the button's relief if it does not yet exist. If there
# is an overrelief setting, Priv($w,relief) will already have been set,
# and the current value of the -relief option will be incorrect.
if {![info exists _private($w,relief)]} {
set _private($w,relief) [$w cget -relief]
}
if {[$w cget -state] != "disabled"} {
set _private(buttonWindow) $w
$w configure -relief sunken
set _private($w,prelief) sunken
# If this button has a repeatdelay set up, get it going with an after
after cancel $_private(afterId)
set delay [$w cget -repeatdelay]
set _private(repeated) 0
if {$delay > 0} {
set cmd [list blt::Button::AutoInvoke $w]
set _private(afterId) [after $delay $cmd]
}
}
}
# Up --
#
# 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.
#
# Arguments:
# w - The name of the widget.
proc ::blt::Button::Up w {
variable _private
if {$w eq $_private(buttonWindow)} {
set _private(buttonWindow) ""
# Restore the button's relief if it was cached.
if {[info exists _private($w,relief)]} {
if {[info exists _private($w,prelief)] && \
$_private($w,prelief) eq [$w cget -relief]} {
$w configure -relief $_private($w,relief)
}
unset -nocomplain _private($w,relief) _private($w,prelief)
}
# Clean up the after event from the auto-repeater
after cancel $_private(afterId)
if {$_private(window) eq $w && [$w cget -state] != "disabled"} {
# Only invoke the command if it wasn't already invoked by the
# auto-repeater functionality
if { $_private(repeated) == 0 } {
uplevel #0 [list $w invoke]
}
}
}
}
|