share/redhat/gui/cframe.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]]
    }
  }
}