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.
147 lines
4.0 KiB
Tcl
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]]
|
|
}
|
|
}
|
|
}
|