Changeset 438


Ignore:
Timestamp:
May 14, 2006, 6:49:38 PM (18 years ago)
Author:
mmc
Message:

Fixed the <enable> facility so that it will work correctly even
when an <enable> statement references an element that is loaded
dynamically into a <structure> parameters section. The element
is not found at first, so Rappture prints out a warning message
to stderr. But when the element is loaded later, the <enable>
condition works as expected.

NOTE: When referencing an element that produces one of these
warnings, you must use the standard notation (i.e., type(name))
for each element in the path. Otherwise, the enable/disable
won't work, but you won't get an error about it.

Location:
trunk/gui/scripts
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/controlOwner.tcl

    r437 r438  
    2525    public method valuefor {path args}
    2626    public method dependenciesfor {path args}
     27    public method ownerfor {path {skip ""}}
    2728    public method changed {path}
    2829    public method regularize {path}
    … …  
    3132    public method tool {}
    3233
     34    protected method _slave {option args}
     35
    3336    protected variable _owner ""     ;# ControlOwner containing this one
    3437    protected variable _path ""      ;# paths within are relative to this
     38    protected variable _slaves ""    ;# this owner has these slaves
    3539    protected variable _xmlobj ""    ;# Rappture XML description
    3640    private variable _path2widget    ;# maps path => widget on this page
    … …  
    4448# ----------------------------------------------------------------------
    4549itcl::body Rappture::ControlOwner::constructor {owner} {
    46     set parts [split $owner @]
    47     set _owner [lindex $parts 0]
    48     set _path [lindex $parts 1]
     50    if {"" != $owner} {
     51        set parts [split $owner @]
     52        set _owner [lindex $parts 0]
     53        set _path [lindex $parts 1]
     54        $_owner _slave add $this
     55    }
    4956}
    5057
    … …  
    7683    # if this is a query operation, then look for the path
    7784    if {[llength $args] == 0} {
     85        set owner [ownerfor $path]
     86        if {$owner != $this && $owner != ""} {
     87            return [$owner widgetfor $path]
     88        }
    7889        if {[info exists _path2widget($path)]} {
    7990            return $_path2widget($path)
    … …  
    103114# ----------------------------------------------------------------------
    104115itcl::body Rappture::ControlOwner::valuefor {path args} {
     116    set owner [ownerfor $path]
     117
    105118    # if this is a query operation, then look for the path
    106119    if {[llength $args] == 0} {
     120        if {$owner != $this && $owner != ""} {
     121            return [$owner valuefor $path]
     122        }
    107123        if {[info exists _path2widget($path)]} {
    108124            return [$_path2widget($path) value]
    109125        }
     126        # can't find the path? try removing the prefix for this owner
     127        set plen [string length $_path]
     128        if {[string equal -length $plen $_path $path]} {
     129            set relpath [string range $path [expr {$plen+1}] end]
     130            if {[info exists _path2widget($relpath)]} {
     131                return [$_path2widget($relpath) value]
     132            }
     133        }
    110134        return ""
    111135    }
    112136
    113137    # otherwise, set the value
     138    if {$owner != $this && $owner != ""} {
     139        return [eval $owner valuefor $path $args]
     140    }
    114141    if {[llength $args] > 1} {
    115142        error "wrong # args: should be \"valuefor path ?newValue?\""
    … …  
    133160# ----------------------------------------------------------------------
    134161itcl::body Rappture::ControlOwner::dependenciesfor {path args} {
     162    if {"" != $_owner} {
     163        #
     164        # Keep all dependencies at the highest level.
     165        # That way, a structure can come and go, but the
     166        # dependencies remain fixed in the topmost tool.
     167        #
     168        set plen [string length $_path]
     169        if {"" != $_path && ![string equal -length $plen $_path $path]} {
     170            set path $_path.$path
     171        }
     172        return [eval $_owner dependenciesfor $path $args]
     173    }
     174
    135175    # if this is a query operation, then look for the path
    136176    if {[llength $args] == 0} {
    … …  
    151191        }
    152192    }
     193}
     194
     195# ----------------------------------------------------------------------
     196# USAGE: ownerfor <path> ?<skip>?
     197#
     198# Returns the ControlOwner that directly controls the specified <path>.
     199# ----------------------------------------------------------------------
     200itcl::body Rappture::ControlOwner::ownerfor {path {skip ""}} {
     201    if {[info exists _path2widget($path)]} {
     202        return $this
     203    }
     204
     205    # can't find the path? try removing the prefix for this owner
     206    set plen [string length $_path]
     207    if {[string equal -length $plen $_path $path]} {
     208        set relpath [string range $path [expr {$plen+1}] end]
     209        if {[info exists _path2widget($relpath)]} {
     210            return $this
     211        }
     212    }
     213
     214    # couldn't find this path?  then check all subordinates
     215    foreach slave $_slaves {
     216        if {$slave == $skip} {
     217            continue  ;# skip this slave if it's already been searched
     218        }
     219        set rval [$slave ownerfor $path $this]
     220        if {"" != $rval} {
     221            return $rval
     222        }
     223    }
     224
     225    # check the owner as a last resort
     226    if {"" != $_owner && $_owner != $skip} {
     227        set rval [$_owner ownerfor $path $this]
     228        if {"" != $rval} {
     229            return $rval
     230        }
     231    }
     232
     233    return ""
    153234}
    154235
    … …  
    191272itcl::body Rappture::ControlOwner::changed {path} {
    192273    if {"" != $_owner} {
     274        set plen [string length $_path]
     275        if {"" != $_path && ![string equal -length $plen $_path $path]} {
     276            set path $_path.$path
     277        }
    193278        $_owner changed $path
    194279    } else {
     280        # send out any callback notifications
    195281        foreach owner [array names _owner2paths] {
    196282            foreach pattern $_owner2paths($owner) {
    … …  
    201287            }
    202288        }
     289
     290        # find the control panel for each dependency, and tell it
     291        # to update its layout.
     292        foreach cpath [dependenciesfor $path] {
     293            set wv [widgetfor $cpath]
     294            while {"" != $wv} {
     295                set wv [winfo parent $wv]
     296                if {[winfo class $wv] == "Controls"} {
     297                    $wv refresh
     298                    break
     299                }
     300            }
     301        }
    203302    }
    204303}
    … …  
    211310# ----------------------------------------------------------------------
    212311itcl::body Rappture::ControlOwner::regularize {path} {
    213     set rpath [$_xmlobj element -as path $path]
    214     if {"" == $rpath} {
    215         #
    216         # Couldn't find this path?  Then this might be a full path.
    217         # Subtract off the context for this control owner and
    218         # look for the relative path.
    219         #
    220         set plen [string length $_path]
    221         if {[string equal -length $plen $_path $path]} {
    222             set relpath [string range $path [expr {$plen+1}] end]
    223             set rpath [$_xmlobj element -as path $relpath]
     312    set owner [ownerfor $path]
     313    if {$owner != $this && $owner != ""} {
     314        return [$owner regularize $path]
     315    }
     316    set rpath ""
     317    if {"" != $_xmlobj} {
     318        set rpath [$_xmlobj element -as path $path]
     319
     320        # can't find the path? try removing the prefix for this owner
     321        if {"" == $rpath} {
     322            set plen [string length $_path]
     323            if {[string equal -length $plen $_path $path]} {
     324                set relpath [string range $path [expr {$plen+2}] end]
     325                set rpath [$_xmlobj element -as path $relpath]
     326            }
     327        }
     328
     329        if {"" != $rpath && "" != $_path} {
     330            # return a full name for the path
     331            set rpath "$_path.$rpath"
    224332        }
    225333    }
    … …  
    328436# ----------------------------------------------------------------------
    329437itcl::body Rappture::ControlOwner::sync {} {
    330     foreach path [array names _path2widget] {
    331         $_xmlobj put $path.current [$_path2widget($path) value]
     438    # sync all of the widgets under control of this owner
     439    if {"" != $_xmlobj} {
     440        foreach path [array names _path2widget] {
     441            set type [$_xmlobj element -as type $path]
     442            if {[lsearch {group separator control} $type] >= 0} {
     443                continue
     444            }
     445            $_xmlobj put $path.current [$_path2widget($path) value]
     446        }
     447    }
     448
     449    # sync all subordinate slaves as well
     450    foreach slave $_slaves {
     451        $slave sync
    332452    }
    333453}
    … …  
    346466    return $this
    347467}
     468
     469# ----------------------------------------------------------------------
     470# USAGE: _slave add <newobj>...
     471#
     472# Used internally to register the parent-child relationship whenever
     473# one ControlOwner is registered to another.  When the parent syncs,
     474# it causes all of its children to sync.  When a name is being
     475# resolved, it is resolved locally first, then up to the parent for
     476# further resolution.
     477# ----------------------------------------------------------------------
     478itcl::body Rappture::ControlOwner::_slave {option args} {
     479    switch -- $option {
     480        add {
     481            eval lappend _slaves $args
     482        }
     483        default {
     484            error "bad option \"$option\": should be add"
     485        }
     486    }
     487}

  • trunk/gui/scripts/controls.tcl

    r437 r438  
    3131    public method index {name}
    3232    public method control {args}
     33    public method refresh {}
    3334
    3435    protected method _layout {}
    … …  
    211212
    212213                    # make sure we have the standard path notation
    213                     set ccpath [$_owner regularize $ccpath]
    214                     if {"" != $ccpath} {
    215                         # substitute [_controlValue ...] call in place of path
    216                         append enable [string range $rest 0 [expr {$s0-1}]]
    217                         append enable [format {[_controlValue %s %s]} $ccpath $units]
    218                         lappend deps $ccpath
    219                     } else {
    220                         # don't recognize this path -- leave it alone
    221                         append enable [string range $rest 0 $s1]
    222                         bgerror "don't recognize parameter $cpath in <enable> expression for $path"
     214                    set stdpath [$_owner regularize $ccpath]
     215                    if {"" == $stdpath} {
     216                        puts stderr "WARNING: don't recognize parameter $cpath in <enable> expression for $path.  This may be buried in a structure that is not yet loaded."
     217                        set stdpath $ccpath
    223218                    }
     219                    # substitute [_controlValue ...] call in place of path
     220                    append enable [string range $rest 0 [expr {$s0-1}]]
     221                    append enable [format {[_controlValue %s %s]} $stdpath $units]
     222                    lappend deps $stdpath
    224223                    set rest [string range $rest [expr {$s1+1}] end]
    225224                }
    … …  
    236235    set _name2info($name-enable) $enable
    237236
     237    $_owner widgetfor $path $w
     238
    238239    if {$type != "control" && $type != "group" && $type != "separator"} {
    239         $_owner widgetfor $path $w
    240 
    241240        # make a label for this control
    242241        set label [$w label]
    … …  
    266265    # now that we have a new control, we should fix the layout
    267266    $_dispatcher event -idle !layout
     267    _controlChanged $name
    268268
    269269    return $name
    … …  
    361361    set opt $params(switch)
    362362    return $_name2info($name$opt)
     363}
     364
     365# ----------------------------------------------------------------------
     366# USAGE: refresh
     367#
     368# Clients use this to refresh the layout of the control panel
     369# whenever a widget within the panel changes visibility state.
     370# ----------------------------------------------------------------------
     371itcl::body Rappture::Controls::refresh {} {
     372    $_dispatcher event -idle !layout
    363373}
    364374
    … …  
    596606    if {"" != $_owner} {
    597607        $_owner changed $path
    598 
    599         #
    600         # If this control has other dependencies, then have them
    601         # update their "enabled" status.
    602         #
    603         foreach cpath [$_owner dependenciesfor $path] {
    604             $_dispatcher event -idle !layout
    605         }
    606608    }
    607609}

  • trunk/gui/scripts/deviceEditor.tcl

    r193 r438  
    9191
    9292    } elseif {[llength $args] == 0} {
    93         sync  ;# querying -- must sync controls with the value
     93        # querying -- nothing to do here
    9494    } else {
    9595        error "wrong # args: should be \"value ?-check? ?newval?\""

  • trunk/gui/scripts/page.tcl

    r437 r438  
    101101            #
    102102            set w "$frame.device[incr num]"
    103             Rappture::DeviceEditor $w $_owner@$path.$cname
     103            Rappture::DeviceEditor ::$w $_owner@$path.$cname.current
    104104            pack $w -expand yes -fill both
    105105            $_owner widgetfor $path.$cname $w
Note: See TracChangeset for help on using the changeset viewer.