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

Text File | 1997-11-20 | 5.5 KB | 206 lines

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

# Start user added include file section
# End user added include file section


Class MTProcs : {Object} {
    constructor
    method destructor
}

constructor MTProcs {class this name} {
    set this [Object::constructor $class $this $name]
    # Start constructor user section
    # End constructor user section
    return $this
}

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

proc MTProcs::isDerived {fromVersion toVersion} {
    if {! [isCommand $toVersion]} {
        # no possible merge
        return 0
    }

    if [$toVersion isA Version] {
        if {$toVersion == $fromVersion ||
        [$toVersion commonBaseVersion $fromVersion] == $fromVersion} {
        return 1
        }
        return 0
    }

    if {[$toVersion versionNumber] >= [$fromVersion versionNumber]} {
        return 1
    }
    return 0
}

proc MTProcs::needMerge {fromVersion toVersions} {

    set toVersion [MTProcs::findToObject $fromVersion $toVersions]
    if [MTProcs::isDerived $fromVersion $toVersion] {
        return ok
    }

    return $toVersion
}

proc MTProcs::needImport {fromVersion parent} {

    if [$fromVersion isA PhaseVersion] {
    set toVersion [.main toPhase]
    } else {
    set toParVer [$parent toRepObj]
    if {$toParVer == ""} {
        return ""
    }
    if [$fromVersion isA SystemVersion] {
        set sysName [[$fromVersion system] name]
        set sysType [[$fromVersion system] type]
        set toVersion [$toParVer findSystemVersion $sysName $sysType]
    } elseif [$fromVersion isA FileVersion] {
        set fileName [[$fromVersion file] qualifiedName]
        set fileType [[$fromVersion file] type]
        set toVersion [$toParVer findFileVersion $fileName $fileType]
    } elseif [$fromVersion isA CustomFileVersion] {
        set fileName [[$fromVersion customFile] name]
        set fileType [[$fromVersion customFile] type]
        set toVersion [$toParVer findCustomFileVersion $fileName $fileType]
    } elseif [$fromVersion isA GroupVersion] {
        set groupName [[$fromVersion group] name]
        set toVersion [$toParVer findGroupVersion $groupName]
    } elseif [$fromVersion isA CorporateGroupVersion] {
        set corpgName [[$fromVersion corporateGroup] name]
        set links [$toParVer corporateGroupVersionLinkList]
        set link [$links find -byName $corpgName]
        if [$link isNil] {
        return ""
        }
        set toVersion [$link corporateGroupVersion]
    } else  {
        return ""
    }
    }

    if [$toVersion isNil] {
    return ""
    }

    # Only ok if to-version is derived from from-version
    if [MTProcs::isDerived $fromVersion $toVersion] {
    return ok
    }

    return $toVersion
}

proc MTProcs::findToObject {fromVersion toVersions} {

    if [$fromVersion isA CorporateGroupVersion] {
        set from [$fromVersion corporateGroup]
        set toVersion [query "corporateGroup == $from" $toVersions]
    } else {
        set from [$fromVersion object]
        set toVersion [query "object == $from" $toVersions]
    }
    return $toVersion
}

proc MTProcs::createMergeLink {mergeObjects comment} {
    foreach mergeObject $mergeObjects {
        set fromVersion [$mergeObject fromRepObj]
        set toVersion [$mergeObject toRepObj]

        MTProcs::freeze $fromVersion "Frozen to create mergelink"
        set toVersion [MTProcs::makeToWorking $mergeObject]
        if {$toVersion != ""} {
            $toVersion createMergeLink $fromVersion $comment
        }
    }
}

proc MTProcs::makeToWorking {mergeObject} {

    set version [$mergeObject toRepObj]

    if {[$version status] == "working"} {
        return $version
    }

    set parent [$mergeObject parent]

    set name [$version getInfo Name].[$version getInfo Type]
    set warning "Creation of new version of '$name' failed"

    if {$parent == ""} {
        wmtkwarning "$warning: no parent found."
        return ""
    }

    set parentVersion [$parent toRepObj]
    if {[$parentVersion isA Version] &&
         $parentVersion != "" && [$parentVersion status] != "working"} {
        set parentVersion [MTProcs::makeToWorking $parent]
        if {$parentVersion == ""} {
            wmtkwarning $warning
            return ""
        }
    }

    set config [.main toConfig]

    if [$version isA FileVersion] {
        set new [$parentVersion derive -fileVersion $version $config]
    } elseif [$version isA SystemVersion] {
        set new [$parentVersion derive -systemVersion $version $config]
        .main toSystem $new
    } elseif [$version isA PhaseVersion] {
        set new [$parentVersion derive -phaseVersion $version]
        .main toPhase $new
    } elseif [$version isA ConfigVersion] {
        set new [$version derive -self]
        .main toConfig $new
    } elseif [$version isA GroupVersion] {
        set new [$parentVersion derive -groupVersion $version $config]
    } elseif [$version isA CustomFileVersion] {
        set new [$parentVersion derive -customFileVersion $version]
    } else {
        wmtkerror "$warning: unkown class name."

        return ""
    }

    # update rep information
    $mergeObject toRepObj $new
    return $new
}

proc MTProcs::freeze {version comment} {

    # check if the element is frozen, if not freeze it
    if {[$version status] == "working"} {
        $version freeze $comment
    }
}

proc MTProcs::showHelpOnContext {} {
    .main helpOnName mergeTool
}

# Do not delete this line -- regeneration end marker