PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/vbtreearea.tcl

Text File | 1997-11-27 | 5.4 KB | 224 lines

#---------------------------------------------------------------------------
#
#      (c)     Cayenne Software Inc.    1997
#
#      File:           @(#)vbtreearea.tcl    /main/titanic/20
#      Author:         <generated>
#      Description:
#---------------------------------------------------------------------------
# SccsId = @(#)vbtreearea.tcl    /main/titanic/20   27 Nov 1997 Copyright 1997 Cayenne Software Inc.

# Start user added include file section

# use the browser object to edit and show the version
# everything works ok if the selfpromoters are avialable
require browserobj.tcl
require vbtrareano.tcl

# End user added include file section


Class VBTreeArea : {TreeArea} {
    method destructor
    constructor
    method setVersionInfo
    method buildTree
    method buildLink
    method getParentVersionObj
    method dropEvent
    method getNode
    method setNode
    method removeNode
    attribute versionable
    attribute node
}

method VBTreeArea::destructor {this} {
    # Start destructor user section
    # End destructor user section
}

constructor VBTreeArea {class this name} {
    set this [TreeArea::constructor $class $this $name]
    $this node [Dictionary new]

    $this nodeSizeX 150
    $this nodeSizeY 75
    $this setSize 600 400
    $this destinationSet "BROWSUIOBJ dropEvent"

    return $this
}

method VBTreeArea::setVersionInfo {this version} {

    # first get the base version

    set roots ""
    if [isCommand [$this versionable]] {
        foreach vers [[$this versionable] versions] {
            if {[$vers baseVersion] == [ORB::nil]} {
                lappend roots $vers
            }
        }
        set version [lindex $roots 0]
    } else {
        foreach vers [[$version object] versions] {
            if {[$vers baseVersion] == [ORB::nil]} {
                lappend roots $vers
            }
        }
    }

    if {$roots == ""} {
        wmtkerror "Unable to show version information. \
            (No versions found)"
        return
    }

    set versionable $this.versionable
    VBTrAreaNode new $versionable $this
    set first [lindex $roots 0]
    $versionable labelA [$first getInfo Name].[$first getInfo Type]
    .main title "ObjectTeam VersionBrowser - [$first getInfo Name]"
    set versions [llength [[$first object] versions]]
    $versionable labelB "Versions: $versions"
    $this versionable [$first object]
    set parent [$this getParentVersionObj]

    foreach root $roots {
        global classCount
        VBTrAreaNode new $versionable.$classCount $versionable
        $versionable.$classCount setVersion $root
        $root parent $parent
        $this setNode $root $versionable.$classCount

        incr classCount
        if ![$root isLeaf] {
            $this buildTree $root
        }
    }

    set versions [query "mergeLinks != [ORB::nil]" $first.object.versions]

    foreach version $versions {
        foreach link [$version mergeLinks] {
            $this buildLink $link
        }
    }

    # adjust menu compare-merge
    if {[$first isA ConfigVersion] || [$first isA PhaseVersion] || \
        [$first isA SystemVersion]} {
        if [isCommand .main.MB.version.menu.compare] {
            .main.MB.version.menu.compare label "Merge..."
            .main.MB.version.menu.compare hintText \
                "Starts mergetool for the selected objects"
            .main.MB.version.menu.compare mnemonic M
        }
    } else {
        if [isCommand .main.MB.version.menu.compare] {
            .main.MB.version.menu.compare label "Compare..."
            .main.MB.version.menu.compare hintText \
                "Compares the selected objects"
            .main.MB.version.menu.compare mnemonic C
        }
    }

    .main selectionChanged 1
}

method VBTreeArea::buildTree {this startVersion} {

    set startNode [$this getNode $startVersion]
    set parent [$this getParentVersionObj]

    foreach version [$startVersion derivedVersions] {
        VBTrAreaNode new $startNode.$classCount $startNode
        $startNode.$classCount setVersion $version
        $version parent $parent
        $this setNode $version $startNode.$classCount
        incr classCount
        if ![$version isLeaf] {
            $this buildTree $version
        }
    }
}

method VBTreeArea::buildLink {this link} {

    set from [$this getNode [$link from]]
    set to [$this getNode [$link to]]
    if {"$from" == "" || "$to" == ""} {
        return
    }
    set curSet [[.main infoView] mergeArrowSet]
    append curSet " $from $to "
    [.main infoView] mergeArrowSet $curSet
}

method VBTreeArea::getParentVersionObj {this} {

    return [[ClientContext::global] currentLevelId]
}

method VBTreeArea::dropEvent {this value srcIsDst object} {

    set value [lindex $value 0]

    set l1 [llength $value]
    incr l1 -3

    set l2 $l1
    incr l2 1

    set cv [lrange $value $l1 $l2]
    set cc [lrange $value 0 $l1]

    set version [VBProcs::id2Obj $cv]

    set slashedCc ""
    foreach elm $cc {
        set obj [VBProcs::id2Obj $elm]
        if {$obj == $version} {
            break;
        }
        append slashedCc /$elm
    }

    set cc [ClientContext::global]
    set corp [[$cc currentCorporate] identity]
    set slashedCc /$corp$slashedCc

    $cc setLevelIds $slashedCc

    .main currentVersion $version
    $this versionable [$version object]
    set config [$cc currentConfig]
    set phase [$cc currentPhase]
    if ![$phase  isNil] {
        $phase parent $config
        set system [$cc currentSystem]
        if ![$system isNil] {
            $system parent $phase
        }
    }

    VBViewMenuProcs::updateView
}

# Do not delete this line -- regeneration end marker

method VBTreeArea::getNode {this version} {
    return [[$this node] set $version]
}

method VBTreeArea::setNode {this version newNode} {
    [$this node] set $version $newNode
}

method VBTreeArea::removeNode {this version} {
    [$this node] unset $version
}