scripts/state.tcl

   1 # state {widget ...} [enabled | disabled]
   2 # intelligently does a config -state on each of the widgets listed,
   3 # setting their background colour to the option database key
   4 # "disabledBackground" or "enabledBackround", or sensible defaults if
   5 # these are not defined.  If the widget's class is not one that takes
   6 # kindly to having it's background set (checkbuttons, etc) then this
   7 # command leaves it alone.  "enabled" is a synonym for "normal"
   8 #
   9 # if $args is blank, it returns the current state (enabled;disabled) of
  10 # the widget.  active is treated as enabled.
  11 #
  12 proc tlc::state {wins args} {
  13         foreach w $wins {
  14                 if {[winfo exists $w]} {
  15                         if {[llength $args] > 0} {
  16                                 set req [lindex $args 0]
  17                                 if {$req == "disabled"} {
  18                                         set state       "disabled"
  19                                 } elseif {$req == "normal" || $req == "enabled"} {
  20                                         set state       "normal"
  21                                 } else {
  22                                         error "$req: expected \['enabled' | 'disabled'\]"
  23                                 }
  24                                 catch {$w config -state $state}
  25                                 switch -exact $state {
  26                                         "normal" {
  27                                                 set bg  [option get . enabledBackground ""]
  28                                                 if {$bg == ""} { set bg "white" }
  29                                         }
  30                                         "disabled" {
  31                                                 set bg  [option get . disabledBackground ""]
  32                                                 if {$bg == ""} { set bg "grey" }
  33                                         }
  34                                 }
  35                                 set class       [winfo class $w]
  36                                 if {[lsearch -exact "Entry Text Listbox" $class] != -1} {
  37                                         $w config -background $bg
  38                                 } elseif {[lsearch -exact "Entryfield Spinint Labeledtextbox Scrolledtext Vartextbox" $class] != -1} {
  39                                         if {$state == "disabled"} {
  40                                                 set fg  $bg
  41                                         } else {
  42                                                 set fg  black
  43                                         }
  44                                         $w config -textbackground $bg -foreground $fg
  45                                 }
  46                         } else {
  47                                 return [$w cget -state]
  48                         }
  49                 } else {
  50                         error "$w is not a valid widget"
  51                 }
  52         }
  53 }
  54
  55
  56 proc tlc::setstate {cond args} {
  57         uplevel [list if $cond "state \"$args\" enabled" else "state \"$args\" disabled"]
  58 }
  59
  60