home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1998 October
/
PCWorld_1998-10_cd.bin
/
software
/
prehled
/
komix
/
DATA.Z
/
vbtrareano.tcl
< prev
next >
Wrap
Text File
|
1997-11-28
|
6KB
|
229 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1997
#
# File: @(#)vbtrareano.tcl /main/titanic/23
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)vbtrareano.tcl /main/titanic/23 28 Nov 1997 Copyright 1997 Cayenne Software Inc.
# Start user added include file section
# End user added include file section
Class VBTrAreaNode : {TrAreaNode} {
method destructor
constructor
method open
method editShow
method edit
method show
method update
method setVersion
method getOwners
attribute version
}
method VBTrAreaNode::destructor {this} {
# Start destructor user section
# remove first all registrated merge links
set newList ""
set list [[$this area] mergeArrowSet]
for {set i 0} {$i+1 < [llength $list]} {incr i +2} {
set from [lindex $list $i]
set to [lindex $list [expr {$i+1}]]
if {$to == $this || $from == $this} {
continue
}
set newList " $newList $from $to "
}
[$this area] mergeArrowSet $newList
[$this area] removeNode $this
# End destructor user section
}
constructor VBTrAreaNode {class this name parent} {
set this [TrAreaNode::constructor $class $this $name $parent]
$this activated {%this open}
return $this
}
method VBTrAreaNode::open {this} {
if {[[$this version] isA ConfigVersion] ||
[[$this version] isA PhaseVersion] ||
[[$this version] isA SystemVersion] } {
VBFileMenuProcs::showInfo
return
}
set status [[$this version] getInfo Status]
if {$status != "backGround"} {
if {$status == "frozen"} {
$this editShow show
} else {
$this editShow edit
}
}
}
method VBTrAreaNode::editShow {this action} {
set version [$this version]
# save current clientContext
set clientContext [ClientContext::global]
set levelIds [$clientContext currentLevelIdString]
# find the owners of this version
set context ""
foreach inSystem [VBProcs::getOwners $version] {
foreach inPhase [VBProcs::getOwners $inSystem] {
foreach inConfig [VBProcs::getOwners $inPhase] {
lappend context "$inConfig $inPhase $inSystem"
}
}
}
if [lempty $context] {
set err "Can not find configuration information of "
set err "$err selected object."
set err "$err\n(Update view with View->Refresh)"
wmtkwarning $err
return
}
if {[llength $context] == 1} {
set context [lindex $context 0]
# there's only one configuration go there
$clientContext upLevel
$clientContext upLevel
$clientContext upLevel
$clientContext downLevelId [lindex $context 0]
$clientContext downLevelId [lindex $context 1]
$clientContext downLevelId [lindex $context 2]
$version ${action}File
# reset right clientcontext
$clientContext setLevelIds $levelIds
return
}
foreach elm $context {
set confV [lindex $elm 0]
set name [[$confV ConfigVersion::config] name]
set version [$confV versionName]
lappend lst "$name (V$version)"
}
# let user make selection of the right configuration
ClassMaker::extend ListDialog SelConfigDialog {version configList
action}
SelConfigDialog new .main.selConfigDialog \
-title "Select configuration to start $action from" \
-entrySet $lst \
-version $version \
-configList $context \
-action $action \
-okPressed {
set index [lindex [%this selectedIndexSet] 0]
set config [lindex [%this configList] $index]
set clientContext [ClientContext::global]
set levelIds [$clientContext currentLevelIdString]
$clientContext upLevel
$clientContext upLevel
$clientContext upLevel
$clientContext downLevelId [lindex $config 0]
$clientContext downLevelId [lindex $config 1]
$clientContext downLevelId [lindex $config 2]
$version [%this action]File
$clientContext setLevelIds $levelIds
}
.main.selConfigDialog popUp
}
method VBTrAreaNode::edit {this} {
$this editShow edit
}
method VBTrAreaNode::show {this} {
$this editShow show
}
method VBTrAreaNode::update {this} {
set version [$this version]
# Reset cache
BrowserProcs::initializeInfo $version $version
set status [$version getInfo Status]
$this labelA [$version getInfo Version]
$this labelB [$version getInfo "Created By"]
case $status {
{frozen} {
$this state A
}
{backGround} {
$this state B
}
{working default} {
$this state C
}
}
set configs {}
foreach owner [$this getOwners] {
# Reset parent cache
BrowserProcs::initializeInfo $owner $owner
append configs "- "
set status [$owner getInfo Status]
if {"$status" != ""} {
append configs "$status "
}
append configs "[$owner text]\n"
}
$version setInfo "Selected In" $configs
set mergers ""
foreach link [$version mergeLinks] {
set from [$link from]
if [$from isA ConfigVersion] {
append mergers " [$from text]"
} elseif [$from isA CustomFileVersion] {
set customLevel [[$from customFile] customLevel]
if [$customLevel isA Phase] {
append mergers "[$from versionName] ([$customLevel name])"
} elseif [catch {set phaseName [[$customLevel phase] name]}] {
resetErrorVars
append mergers "[$from versionName] ([$customLevel text])"
} else {
append mergers "[$from versionName] ($phaseName)"
}
} else {
set phaseName [[$from phase] name]
append mergers "[$from versionName] ($phaseName)"
}
append mergers " -> [$link comments]\n"
}
$version setInfo "Merged From" $mergers
}
method VBTrAreaNode::setVersion {this version} {
$this version $version
$this update
}
method VBTrAreaNode::getOwners {this} {
return [VBProcs::getOwners [$this version]]
}
# Do not delete this line -- regeneration end marker