Changeset 438 for trunk/gui/scripts
- Timestamp:
- May 14, 2006, 6:49:38 PM (18 years ago)
- Location:
- trunk/gui/scripts
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/controlOwner.tcl
r437 r438 25 25 public method valuefor {path args} 26 26 public method dependenciesfor {path args} 27 public method ownerfor {path {skip ""}} 27 28 public method changed {path} 28 29 public method regularize {path} … … 31 32 public method tool {} 32 33 34 protected method _slave {option args} 35 33 36 protected variable _owner "" ;# ControlOwner containing this one 34 37 protected variable _path "" ;# paths within are relative to this 38 protected variable _slaves "" ;# this owner has these slaves 35 39 protected variable _xmlobj "" ;# Rappture XML description 36 40 private variable _path2widget ;# maps path => widget on this page … … 44 48 # ---------------------------------------------------------------------- 45 49 itcl::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 } 49 56 } 50 57 … … 76 83 # if this is a query operation, then look for the path 77 84 if {[llength $args] == 0} { 85 set owner [ownerfor $path] 86 if {$owner != $this && $owner != ""} { 87 return [$owner widgetfor $path] 88 } 78 89 if {[info exists _path2widget($path)]} { 79 90 return $_path2widget($path) … … 103 114 # ---------------------------------------------------------------------- 104 115 itcl::body Rappture::ControlOwner::valuefor {path args} { 116 set owner [ownerfor $path] 117 105 118 # if this is a query operation, then look for the path 106 119 if {[llength $args] == 0} { 120 if {$owner != $this && $owner != ""} { 121 return [$owner valuefor $path] 122 } 107 123 if {[info exists _path2widget($path)]} { 108 124 return [$_path2widget($path) value] 109 125 } 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 } 110 134 return "" 111 135 } 112 136 113 137 # otherwise, set the value 138 if {$owner != $this && $owner != ""} { 139 return [eval $owner valuefor $path $args] 140 } 114 141 if {[llength $args] > 1} { 115 142 error "wrong # args: should be \"valuefor path ?newValue?\"" … … 133 160 # ---------------------------------------------------------------------- 134 161 itcl::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 135 175 # if this is a query operation, then look for the path 136 176 if {[llength $args] == 0} { … … 151 191 } 152 192 } 193 } 194 195 # ---------------------------------------------------------------------- 196 # USAGE: ownerfor <path> ?<skip>? 197 # 198 # Returns the ControlOwner that directly controls the specified <path>. 199 # ---------------------------------------------------------------------- 200 itcl::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 "" 153 234 } 154 235 … … 191 272 itcl::body Rappture::ControlOwner::changed {path} { 192 273 if {"" != $_owner} { 274 set plen [string length $_path] 275 if {"" != $_path && ![string equal -length $plen $_path $path]} { 276 set path $_path.$path 277 } 193 278 $_owner changed $path 194 279 } else { 280 # send out any callback notifications 195 281 foreach owner [array names _owner2paths] { 196 282 foreach pattern $_owner2paths($owner) { … … 201 287 } 202 288 } 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 } 203 302 } 204 303 } … … 211 310 # ---------------------------------------------------------------------- 212 311 itcl::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" 224 332 } 225 333 } … … 328 436 # ---------------------------------------------------------------------- 329 437 itcl::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 332 452 } 333 453 } … … 346 466 return $this 347 467 } 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 # ---------------------------------------------------------------------- 478 itcl::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 31 31 public method index {name} 32 32 public method control {args} 33 public method refresh {} 33 34 34 35 protected method _layout {} … … 211 212 212 213 # 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 223 218 } 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 224 223 set rest [string range $rest [expr {$s1+1}] end] 225 224 } … … 236 235 set _name2info($name-enable) $enable 237 236 237 $_owner widgetfor $path $w 238 238 239 if {$type != "control" && $type != "group" && $type != "separator"} { 239 $_owner widgetfor $path $w240 241 240 # make a label for this control 242 241 set label [$w label] … … 266 265 # now that we have a new control, we should fix the layout 267 266 $_dispatcher event -idle !layout 267 _controlChanged $name 268 268 269 269 return $name … … 361 361 set opt $params(switch) 362 362 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 # ---------------------------------------------------------------------- 371 itcl::body Rappture::Controls::refresh {} { 372 $_dispatcher event -idle !layout 363 373 } 364 374 … … 596 606 if {"" != $_owner} { 597 607 $_owner changed $path 598 599 #600 # If this control has other dependencies, then have them601 # update their "enabled" status.602 #603 foreach cpath [$_owner dependenciesfor $path] {604 $_dispatcher event -idle !layout605 }606 608 } 607 609 } -
trunk/gui/scripts/deviceEditor.tcl
r193 r438 91 91 92 92 } elseif {[llength $args] == 0} { 93 sync ;# querying -- must sync controls with the value93 # querying -- nothing to do here 94 94 } else { 95 95 error "wrong # args: should be \"value ?-check? ?newval?\"" -
trunk/gui/scripts/page.tcl
r437 r438 101 101 # 102 102 set w "$frame.device[incr num]" 103 Rappture::DeviceEditor $w $_owner@$path.$cname103 Rappture::DeviceEditor ::$w $_owner@$path.$cname.current 104 104 pack $w -expand yes -fill both 105 105 $_owner widgetfor $path.$cname $w
Note: See TracChangeset
for help on using the changeset viewer.