neingeist
/
arduinisten
Archived
1
0
Fork 0
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

147 lines
4.0 KiB
Tcl

# cframe.tcl - Frame controlled by checkbutton.
# Copyright (C) 1997 Cygnus Solutions.
# Written by Tom Tromey <tromey@cygnus.com>.
itcl_class Checkframe {
inherit Widgetframe
# The checkbutton text.
public text {} {
_set_option -text $text 0
}
# This holds the last value of -variable. We use it to unset our
# trace when the variable changes (or is deleted). Private
# variable.
protected _saved_variable {}
# The checkbutton variable.
public variable {} {
_var_changed
}
# The checkbutton -onvalue.
public onvalue 1 {
_set_option -onvalue $onvalue
}
# The checkbutton -offvalue.
public offvalue 0 {
_set_option -offvalue $offvalue
}
# The checkbutton -command.
public command {} {
_set_option -command $command 0
}
# This holds balloon help for the checkbutton.
public help {} {
if {[winfo exists [namespace tail $this].check]} then {
balloon register [namespace tail $this].check $help
}
}
# This holds a list of all widgets which should be immune to
# enabling/disabling. Private variable.
protected _avoid {}
constructor {config} {
checkbutton [namespace tail $this].check -text $text -variable $variable -padx 2 \
-command $command -onvalue $onvalue -offvalue $offvalue
balloon register [namespace tail $this].check $help
_add [namespace tail $this].check
}
# Exempt a child from state changes. Argument EXEMPT is true if the
# child should be exempted, false if it should be re-enabled again.
# Public method.
method exempt {child {exempt 1}} {
if {$exempt} then {
if {[lsearch -exact $_avoid $child] == -1} then {
lappend _avoid $child
}
} else {
set _avoid [lremove $_avoid $child]
_set_visibility $child
}
}
# This is run when the state of the frame's children should change.
# Private method.
method _set_visibility {{child {}}} {
if {$variable == ""} then {
# No variable means everything is ok. The behavior here is
# arbitrary; this is a losing case.
set state normal
} else {
upvar \#0 $variable the_var
if {! [string compare $the_var $onvalue]} then {
set state normal
} else {
set state disabled
}
}
if {$child != ""} then {
$child configure -state $state
} else {
# FIXME: we force our logical children to be actual children of
# the frame. Instead we should ask the geometry manager what's
# going on.
set avoid(_) {}
unset avoid(_)
foreach child $_avoid {
set avoid($child) {}
}
foreach child [winfo children [namespace tail $this].iframe.frame] {
if {! [info exists avoid($child)]} then {
catch {$child configure -state $state}
}
}
}
}
# This is run to possibly update some option on the checkbutton.
# Private method.
method _set_option {option value {set_vis 1}} {
if {[winfo exists [namespace tail $this].check]} then {
[namespace tail $this].check configure $option $value
if {$set_vis} then {
_set_visibility
}
}
}
# This is run when our associated variable changes. We use the
# resulting information to set the state of our children. Private
# method.
method _trace {name1 name2 op} {
if {$op == "u"} then {
# The variable got deleted. So we stop looking at it.
uplevel \#0 [list trace vdelete $_saved_variable uw [list $this _trace]]
set _saved_variable {}
set variable {}
} else {
# Got a write.
_set_visibility
}
}
# This is run when the -variable changes. We remove our old trace
# (if there was one) and add a new trace (if we need to). Private
# method.
method _var_changed {} {
if {$_saved_variable != ""} then {
# Remove the old trace.
uplevel \#0 [list trace vdelete $_saved_variable uw [list $this _trace]]
}
set _saved_variable $variable
if {$variable != ""} then {
# Set a new trace.
uplevel \#0 [list trace variable $variable uw [list $this _trace]]
}
}
}