home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cadre Technologies Inc. 1996
- #
- # File: @(#)groupvdbob.tcl /main/hindenburg/7
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)groupvdbob.tcl /main/hindenburg/7 7 Nov 1996 Copyright 1996 Cadre Technologies Inc.
-
- # Start user added include file section
- # End user added include file section
-
- require "browsdbobj.tcl"
- require "versionobj.tcl"
-
- Class GroupVDbObj : {BrowsDbObj GroupVersion VersionObj} {
- method destructor
- constructor
- method promoter
- method canBeDragged
- method changeLinks
- method copyVersion
- method directFileVersions
- method directSubgroupVersions
- method editFile
- method filterFileVersions
- method filterItems
- method filterSubgroupVersions
- method group
- method initializeInfo
- method linkStatus
- method name
- method newObjects
- method openFile
- method printObjects
- method removeObjects
- method removeVersion
- method savedGroupVersions
- method showFile
- method snapshotObjects
- attribute savedGroupVersionSet
- }
-
- method GroupVDbObj::destructor {this} {
- # Start destructor user section
-
- [$this controlledListSet] delete
- [$this savedGroupVersionSet] delete
-
- # End destructor user section
- $this BrowsDbObj::destructor
- $this VersionObj::destructor
- }
-
- constructor GroupVDbObj {class this name} {
- set this [GroupVersion::constructor $class $this $name]
- set this [BrowsDbObj::constructor $class $this $name]
- set this [VersionObj::constructor $class $this $name]
- return $this
- }
-
- selfPromoter GroupVersion {this} {
- GroupVDbObj promote $this
- }
-
- method GroupVDbObj::promoter {this} {
- $this BrowsDbObj::promoter
-
- set controlledListSet $this.${CListUiObj::uiClass}:0
- if {! [isCommand $controlledListSet]} {
- CListUiObj new $controlledListSet -parent $this
- }
- $this controlledListSet $controlledListSet
- set savedGroupVersionSet $this.${SvdGVUiObj::uiClass}:0
- if {! [isCommand $savedGroupVersionSet]} {
- SvdGVUiObj new $savedGroupVersionSet -parent $this
- }
- $this savedGroupVersionSet $savedGroupVersionSet
- }
-
- proc GroupVDbObj::associations {} {
- return {\
- directFileVersions directSubgroupVersions savedGroupVersionSet \
- controlledListSet accessRuleSet\
- }
- }
-
- method GroupVDbObj::canBeDragged {this} {
- return 1
- }
-
- method GroupVDbObj::changeLinks {this} {
- [$this getParent SystemVersion] changeLinks
- }
-
- proc GroupVDbObj::childTypes {assoc} {
- if {[lsearch -exact "[GroupVDbObj::associations]" "$assoc"] == -1} {
- return ""
- }
- set childTypes [BrowserProcs::childTypes "$assoc"]
- case "$childTypes" in {
- {DirectFileVersion} {
- return [concat \
- ${BrowserProcs::diagramFileTypes} \
- ${BrowserProcs::programmerFileTypes}]
- }
- {DirectSubgroupVersion} {
- return "GroupVersion"
- }
- {default} {
- return "$childTypes"
- }
- }
- }
-
- proc GroupVDbObj::controlledLists {} {
- return {"[[$this group] groupVersionList]"}
- }
-
- method GroupVDbObj::copyVersion {this} {
- set versionList ""
- foreach system [[$this phase] systems] {
- foreach group [$system groups] {
- foreach version [$group groupVersions] {
- if {"$version" == "$this"} continue
- lappend versionList [list $version "[$group name]"]
- }
- }
- }
- BrowserProcs::copyVersion $this $versionList
- }
-
- method GroupVDbObj::directFileVersions {this} {
- set link [[$this info] set SystemGroupLink]
- if [isCommand $link] {
- set sysV [$link systemVersion]
- } else {
- set sysV [$this getParent SystemVersion]
- }
- foreach fileV [$this explicitFileVersions $sysV] {
- set directFileVersions($fileV) 1
- }
- foreach fileV [$this GroupVersion::filterFileVersions $sysV] {
- set directFileVersions($fileV) 1
- }
- if [info exists directFileVersions] {
- return [array names directFileVersions]
- }
- return ""
- }
-
- method GroupVDbObj::directSubgroupVersions {this} {
- set link [[$this info] set SystemGroupLink]
- if [isCommand $link] {
- set sysV [$link systemVersion]
- } else {
- set sysV [$this getParent SystemVersion]
- }
- foreach subgroupV [$this explicitSubgroupVersions $sysV] {
- set directSubgroupVersions($subgroupV) 1
- }
- foreach subgroupV [$this GroupVersion::filterSubgroupVersions $sysV] {
- set directSubgroupVersions($subgroupV) 1
- }
- if [info exists directSubgroupVersions] {
- return [array names directSubgroupVersions]
- }
- return ""
- }
-
- method GroupVDbObj::editFile {this} {
- require "groupvstrd.tcl"
-
- if {[$this getInfo Status] != "working"} {
- $this showFile
- return
- }
- global classCount
- set box .main.groupVStructureDialog$classCount
- incr classCount
- GroupVStrDlg new $box $this \
- -editable 1 \
- -title "Edit Group Structure" \
- -helpPressed {.main helpOnName groupVStructureDialog}
- $box popUp
- }
-
- method GroupVDbObj::filterFileVersions {this filter} {
- set sysV [[[$this info] set SystemGroupLink] systemVersion]
- if {"$filter" == ""} {
- return [$this GroupVersion::filterFileVersions $sysV]
- }
- return [$sysV filterResult $filter]
- }
-
- method GroupVDbObj::filterItems {this filter} {
- set sysV [[[$this info] set SystemGroupLink] systemVersion]
- if {"$filter" == ""} {
- return [$this GroupVersion::filterItems $sysV]
- }
- return [$sysV filterResult $filter]
- }
-
- method GroupVDbObj::filterSubgroupVersions {this filter} {
- set sysV [[[$this info] set SystemGroupLink] systemVersion]
- if {"$filter" == ""} {
- return [$this GroupVersion::filterSubgroupVersions $sysV]
- }
- return [$sysV filterResult $filter]
- }
-
- method GroupVDbObj::group {this} {
- if {[catch {set group [[[$this info] set SystemGroupLink] group]}] ||
- [$group isNil]} {
- global errorInfo
- set errorInfo ""
- global errorCode
- set errorCode ""
- return [$this GroupVersion::group]
- }
- return $group
- }
-
- proc GroupVDbObj::infoProperties {} {
- return [concat \
- [BrowserProcs::infoProperties] \
- {Status Link Version Comments Created Updated Frozen \
- "Controlled Actions" "Created By"} \
- ]
- }
-
- method GroupVDbObj::initializeInfo {this dummy} {
- set oldLink [[$this info] set SystemGroupLink]
- [$this info] contents ""
- $this setInfo SystemGroupLink $oldLink
- }
-
- method GroupVDbObj::linkStatus {this} {
- return [[[$this info] set SystemGroupLink] status]
- }
-
- method GroupVDbObj::name {this} {
- return "[[$this group] name]"
- }
-
- method GroupVDbObj::newObjects {this} {
- [$this getParent SystemVersion] newObjects
- }
-
- method GroupVDbObj::openFile {this} {
- case [$this getInfo Status] in {
- backGround {
- set treeNode [$this treeNode]
- if {"$treeNode" != ""} {
- $treeNode open
- } else {
- [$this infoObject] open
- }
- }
- working {
- $this editFile
- }
- default {
- $this showFile
- }
- }
- }
-
- method GroupVDbObj::printObjects {this} {
- set asciiFiles ""
- set topostObjects ""
- foreach obj [$wmttoolObj selectedObjSet] {
- if [$obj isA Graph] {
- lappend topostObjects $obj
- } elseif [$obj isA ExternalFileVersion] {
- $obj synchWithFileSystem
- lappend asciiFiles [$obj path]
- }
- }
- BrowserProcs::printObjects $asciiFiles "" $topostObjects
- }
-
- method GroupVDbObj::removeObjects {this} {
- [$this getParent SystemVersion] removeObjects
- }
-
- method GroupVDbObj::removeVersion {this} {
- set versionList ""
- foreach version [[$this group] groupVersions] {
- if [$version isLeaf] {
- lappend versionList $version
- }
- }
- BrowserProcs::removeVersion \
- [$this getParent SystemVersion] "[$this group]" "$versionList"
- }
-
- method GroupVDbObj::savedGroupVersions {this} {
- set savedGroup [[$this group] savedGroup]
- if [$savedGroup isNil] {
- return ""
- }
- return [$savedGroup savedGroupVersions]
- }
-
- method GroupVDbObj::showFile {this} {
- require "groupvstrd.tcl"
-
- global classCount
- set box .main.groupVStructureDialog$classCount
- incr classCount
- GroupVStrDlg new $box $this \
- -editable 0 \
- -title "Show Group Structure" \
- -helpPressed {.main helpOnName groupVStructureDialog}
- $box popUp
- }
-
- method GroupVDbObj::snapshotObjects {this} {
- [$this getParent SystemVersion] snapshotObjects
- }
-
- # Do not delete this line -- regeneration end marker
-
-