glennj Some time ago [L1 ], I because frustrated with Tk's default checkbutton. I wanted it to accept any boolean value [L2 ]. I ended up writing this package:
package require Tk
package provide booleanCheckbutton 0.1
# create a checkbutton that selects when it's variable is set to
# a boolean true value
#
# arguments:
# widget - the widget "pathName"
# args - list of checkbutton configuration options
#
# example:
# set cb [booleanCheckbutton .bcb -textvariable bcbVal \
# -text "checkbutton label" -relief flat]
# set bcbVal true
#
# Any errors will be propagated up to the caller.
#
proc booleanCheckbutton {pathName args} {
# create the checkbutton with the specified options
eval [linsert $args 0 checkbutton $pathName]
set varName [$pathName cget -variable]
# ensure the trace occurs in the global scope
uplevel #0 "
trace remove variable $varName write {selectIfTrue $pathName}
trace add variable $varName write {selectIfTrue $pathName}
"
# create the trace command, if it doesn't exist
if {[lsearch -exact [info procs] selectIfTrue] == -1} {
proc selectIfTrue {widget varName arrayIndex op} {
if {$op eq "write"} {
if {$arrayIndex eq ""} {
upvar $varName var
} else {
upvar ${varName}($arrayIndex) var
}
if {[string is boolean -strict $var] && $var} {
set var [$widget cget -onvalue]
}
}
}
}
# trigger the trace for the current value of $varName, if it exists
uplevel #0 "set $varName \[set $varName]"
return $pathName
}
if 0 {
# test
package require Tk
package require booleanCheckbutton
entry .e -textvar entry_value
bind .e <Return> {set checkbutton_value $entry_value; set entry_value ""}
booleanCheckbutton .c checkbutton_value -textvar checkbutton_value
button .l -text "type a value, hit return, observe the checkbutton"
pack .l .e .c
}