home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cayenne Software Inc. 1997
- #
- # File: @(#)sysvdbobj.tcl /main/titanic/30
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)sysvdbobj.tcl /main/titanic/30 26 Nov 1997 Copyright 1997 Cayenne Software Inc.
-
- # Start user added include file section
- require "custfvuiob.tcl"
- require "witemuiobj.tcl"
- # End user added include file section
-
- require "browsdbobj.tcl"
- require "versionobj.tcl"
-
- Class SysVDbObj : {BrowsDbObj SystemVersion VersionObj} {
- method destructor
- constructor
- method promoter
- method activateObject
- method changeLinks
- method copy
- method copyConflict
- method handleConflict
- method copyFileVersions
- method copyGroupVersion
- method copyVersion
- method deactivateObject
- method deselectObjects
- method finalizeCopy
- method finalizeFailedCopy
- method groupVersions
- method importObject
- method importObjects
- method initializeInfo
- method linkStatus
- method localFileVersions
- method localFileOnlyVersions
- method makeUpToDate
- method moveFileVersions
- method name
- method newObjects
- method removeObjects
- method removeVersion
- method reuse
- method reused
- method selectObject
- method system
- attribute workItemSet
- }
-
- method SysVDbObj::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this BrowsDbObj::destructor
- $this VersionObj::destructor
- }
-
- constructor SysVDbObj {class this name} {
- set this [SystemVersion::constructor $class $this $name]
- set this [BrowsDbObj::constructor $class $this $name]
- set this [VersionObj::constructor $class $this $name]
- return $this
- }
-
- selfPromoter SystemVersion {this} {
- if {"[[$this system] type]" == "document"} {
- SysVDbObj promote $this
- } elseif {"[[$this phase] type]" == "Implementation"} {
- PSysVDbObj promote $this
- } else {
- SSysVDbObj promote $this
- }
- }
-
- method SysVDbObj::promoter {this} {
- $this BrowsDbObj::promoter
-
- set customFileVersionSet $this.${CustFVUiObj::uiClass}:0
- if {! [isCommand $customFileVersionSet]} {
- CustFVUiObj new $customFileVersionSet -parent $this
- }
- $this customFileVersionSet $customFileVersionSet
- set workItemSet $this.${WItemUiObj::uiClass}:0
- if {! [isCommand $workItemSet]} {
- WItemUiObj new $workItemSet -parent $this
- }
- $this workItemSet $workItemSet
-
- module_promoter SysVDbObj $this
- }
-
- method SysVDbObj::activateObject {this} {
- # empty
- }
-
- method SysVDbObj::changeLinks {this} {
-
- ClassMaker::extend TemplateDialog ChangeLinksTemplateDialog dbObj
- ChangeLinksTemplateDialog new $wmttoolObj.changeLink \
- -modal yes \
- -title "Change Link Status" \
- -dbObj $this \
- -helpPressed {.main helpOnName changeLink} \
- -cancelPressed {%this delete} \
- -okPressed {
- set status [%this.top.status selected]
- set script ""
- foreach obj [$wmttoolObj selectedObjSet] {
- if [$obj isA PropertySection] {
- wmtkerror "Can not set the link status of a PropertySection"
- continue
- }
- set found 0
- foreach link [$obj systemVersionLinks] {
- if {"[$link systemVersion]" == "[%this dbObj]"} {
- set found 1
- break
- }
- }
- if {! $found} {
- wmtkerror "link to [$obj getInfo Type] \
- '[$obj getInfo Name]' not found"
- continue
- }
- if {"$script" != ""} {
- append script " ;"
- }
- append script " $link status $status"
- }
- if {"$script" != ""} {
- $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
- }
- %this delete
- }
- interface DlgColumn $wmttoolObj.changeLink.top {
- Label messageLab {
- text "Link Status:"
- }
- VerRadioGroup status {
- entrySet {fixed dynamicFrozen}
- }
- }
- if {[llength [$wmttoolObj selectedObjSet]] == 1} {
- $wmttoolObj.changeLink.top.status selected \
- [[lindex [$wmttoolObj selectedObjSet] 0] getInfo Link]
- } else {
- $wmttoolObj.changeLink.top.status selected fixed
- }
- $wmttoolObj.changeLink popUp
- }
-
- proc SysVDbObj::childTypes {assoc} {
- set childTypes [BrowserProcs::childTypes $assoc]
- case "$childTypes" in {
- {ExternalLink} {
- return "${BrowserProcs::externalFileTypes}"
- }
- {FileVersionReference LocalFileVersion} {
- return [concat \
- ${BrowserProcs::diagramFileTypes} \
- ${BrowserProcs::programmerFileTypes}]
- }
- {Section} {
- return [concat \
- {None Fileprop Itemprop} \
- ${BrowserProcs::diagramFileTypes} \
- ${BrowserProcs::programmerFileTypes}]
- }
- {default} {
- return "$childTypes"
- }
- }
- }
-
- proc SysVDbObj::controlledLists {} {
- return {
- "[[$this system] customFileList]"
- "[$this customFileVersionLinkList]"
- "[[$this system] fileList]"
- "[$this fileVersionLinkList]"
- "[[$this system] systemVersionList]"
- }
- }
-
- method SysVDbObj::copy {this sourceContext args} {
- set argc [llength $args]
- set flag [lindex $args 0]
- case "$flag" in {
- {-fileVersion} {
- if {$argc <= 3} {
- eval $this SystemVersion::copy $args
- break
- }
- set fileV [lindex $args 1]
- set editPasteCmdBusy [lindex $args [expr $argc -1]]
- set newFileV [eval \
- $this SystemVersion::copy [lrange $args 0 [expr $argc -2]]]
- if {$editPasteCmdBusy && (! [$newFileV isNil])} {
- [.main undoCommand] addObject $newFileV
- }
- }
- {-groupVersion} {
- if {$argc <= 5} {
- eval $this SystemVersion::copy $args
- break
- }
- set groupV [lindex $args 1]
- set fromSysV [lindex $args 2]
- set editPasteCmdBusy [lindex $args [expr $argc -1]]
-
- set groupName [$groupV name]
- set oldGroupV [$this findGroupVersion $groupName]
- if {! [$oldGroupV isNil]} {
- $this deselectVersion $oldGroupV
- if $editPasteCmdBusy {
- [.main undoCommand] addDeselected $oldGroupV
- }
- }
- if [catch {
- eval $this SystemVersion::copy \
- [lrange $args 0 [expr $argc -2]] "definition" \
- } errorMessage] {
- $fromSysV select -groupVersion $groupV
- if $editPasteCmdBusy {
- [.main undoCommand] delete
- }
- wmtkerror $errorMessage
- }
- if $editPasteCmdBusy {
- set newGroupV [$this findGroupVersion $groupName]
- if {! [$newGroupV isNil]} {
- [.main undoCommand] addObject $newGroupV
- }
- }
- }
- {default} {
- eval $this SystemVersion::copy $args
- }
- }
- }
-
-
- # Handle copy conflict. Pop up options to
- # resolve it based on conflictType and conflictMessage
- # and retry the copy.
- #
- method SysVDbObj::copyConflict {this fileVersions conflictType conflictingFiles fromConfV fromSysV editPasteCmdBusy} {
- interface TemplateDialog .main.copyconflict {
- title "Copy Conflict"
- DlgColumn col {
- DlgRow row {
- Label message {
- }
- }
- }
- PushButton overwrite {
- label "Overwrite"
- }
- PushButton skip {
- label "Skip"
- }
- }
-
- if { $conflictType == "NameConflict" } {
- .main.copyconflict.col.row.message text "Conflicting files:"
- Viewport new .main.copyconflict.col.vp
- set filescol .main.copyconflict.col.vp.col
- DlgColumn new $filescol
-
- set count 1
- foreach fileV $conflictingFiles {
- set typeSpec [getObjectSpec [.main objectHdlr] \
- [$fileV uiClass] [$fileV browserType] \
- ]
- if {"$typeSpec" != ""} {
- set icon [$typeSpec smallIcon]
- } else {
- set icon ""
- }
-
- DlgRow new $filescol.row$count -spaceType NONE
- set fileName [[$fileV file] name]
- if { $icon != "" } {
- Image new $filescol.row$count.ico -pixmap $icon
- }
- Label new $filescol.row$count.file -text "$fileName"
- incr count
- }
- } else {
- .main.copyconflict.col.row.message text "There are conflicting items"
- }
- .main.copyconflict delOkButton
- .main.copyconflict helpPressed {.main helpOnName copyConflict}
-
- .main.copyconflict.overwrite activated \
- "$this handleConflict [list $fileVersions] \
- overwrite $fromConfV $fromSysV $editPasteCmdBusy"
- .main.copyconflict.skip activated \
- "$this handleConflict [list $fileVersions] \
- skip $fromConfV $fromSysV $editPasteCmdBusy"
-
- .main.copyconflict popUp
- }
-
- method SysVDbObj::handleConflict {this fileVersions copyMode fromConfV fromSysV editPasteCmdBusy} {
- .main.copyconflict popDown
- .main.copyconflict delete
- if [catch {
- set copyResult [$this SystemVersion::copy -specified $fileVersions \
- $copyMode files $fromConfV]
- } errorMsg] {
- $this finalizeFailedCopy $fromSysV $errorMsg $editPasteCmdBusy
- return
- }
-
- if { !$copyResult } {
- $this finalizeCopy $files $fromSysV $editPasteCmdBusy
- }
- }
-
-
- # Copies the specified file versions to this system
- # using the 'copyspecs' copy method.
- #
- method SysVDbObj::copyFileVersions {this sourceSystem sourceConfig args} {
- set argc [llength $args]
-
- # -fileVersion
- set type [lindex $args 0]
- set fileVs [lindex $args 1]
- set editPasteCmdBusy [lindex $args 2]
-
- # removed: automatic deselection of existing files
- wmtkmessage "Copying file(s)"
- if [catch {
- set copyResult [$this SystemVersion::copy \
- -specified "$fileVs" abort files $sourceConfig]
- } errorMsg] {
- $this finalizeFailedCopy $sourceSystem $errorMsg $editPasteCmdBusy
- return 0
- }
- wmtkmessage ""
-
-
- if { $copyResult == -1 } {
- if { $files == "" } {
- set conflictType "ItemConflict"
- } else {
- set conflictType "NameConflict"
- }
- $this copyConflict $fileVs $conflictType \
- $files $sourceConfig $sourceSystem $editPasteCmdBusy
- } else {
- if $editPasteCmdBusy {
- $this finalizeCopy $files $sourceSystem $editPasteCmdBusy
- }
- }
- }
-
- method SysVDbObj::copyGroupVersion {this groupV fromSysV fromConfV toConfV} {
- # empty
- }
-
- method SysVDbObj::copyVersion {this} {
- set myType "[[$this system] type]"
- set versionList ""
- foreach system [[$this phase] systems] {
- if {"[$system type]" != "$myType"} continue
- foreach version [$system systemVersions] {
- if {"$version" == "$this"} continue
- lappend versionList [list $version "[$system name]"]
- }
- }
- BrowserProcs::copyVersion $this $versionList
- }
-
- method SysVDbObj::deactivateObject {this} {
- # empty
- }
-
- method SysVDbObj::deselectObjects {this} {
- set script ""
- foreach obj [$wmttoolObj selectedObjSet] {
- if {"$script" != ""} {
- append script " ;"
- }
- append script " $this deselectVersion $obj"
- }
- $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
- }
-
-
- # Administer the result of the copy of
- # the specified file versions in the undocommand.
- #
- method SysVDbObj::finalizeCopy {this fileVersions fromSysV editPasteCmdBusy} {
- if $editPasteCmdBusy {
- foreach file $fileVersions {
- [.main undoCommand] addObject $file
- }
- if {$this == [[.main currentObj] browsUiObj]} {
- .main updateView
- }
- }
- }
-
- method SysVDbObj::finalizeFailedCopy {this fromSysV errorMessage editPasteCmdBusy} {
- if {$editPasteCmdBusy && "[[.main undoCommand] operation]" == "cut"} {
- set restoreFileVs {}
- foreach cutFileV [.main cutFileVersions] {
- if { [lsearch -exact $restoreFileVs $cutFileV] == -1 } {
- lappend restoreFileVs $cutFileV
- }
- }
-
- foreach fileV $restoreFileVs {
- $fromSysV select -fileVersion $fileV
- }
- }
- wmtkmessage ""
- if $editPasteCmdBusy {
- [.main undoCommand] delete
- }
- wmtkerror $errorMessage
- }
-
- method SysVDbObj::groupVersions {this} {
- # empty
- }
-
- method SysVDbObj::importObject {this context node} {
- set len [llength $context]
- set type [lindex $context [expr $len - 2]]
-
- if {$this == [[.main currentObj] browsUiObj]} {
- set update 1
- } else {
- set update 0
- }
-
- # Import CorporateGroupVersion
- if {$len == 3} {
- set corpGVId [lindex $context 0]
- set corpGV [BrowserProcs::id2obj $corpGVId CorporateGroupVersion $node]
-
- # Make sure CorporateGroupVersion exists
- if [catch {$corpGV corporateGroup}] {
- wmtkinfo "Can not import [lindex $context 1] because it is removed"
- if [isCommand [.main undoCommand]] {
- [.main undoCommand] delete
- }
- return 1
- }
-
- set dstType [[$this phase] type]
- set srcType [[[[$corpGV savedGroupVersion] system] phase] type]
- if {"$srcType" != "$dstType" &&
- ("$srcType" == "Implementation" ||
- "$dstType" == "Implementation")} {
- wmtkmessage "Can not import '$type' from '$srcType' to '$dstType'"
- if [isCommand [.main undoCommand]] {
- [.main undoCommand] delete
- }
- return 0
- }
-
- set myConfV [$node getParent ConfigVersion]
- set editPasteCmdBusy [.main undoCommandBusy EditPasteCmd]
- set script "$this reuse $corpGV $myConfV $editPasteCmdBusy"
- $wmttoolObj startCommand tcl \
- "$script" "" \
- "Reusing [$corpGV getInfo Text]" \
- [list $update 0] 1
-
- return 1
- }
-
- set sysVId [lindex $context 3]
- if {$sysVId == [$this getInfo Identity]} {
- wmtkmessage "Can not import object into its own parent"
- if [isCommand [.main undoCommand]] {
- [.main undoCommand] delete
- }
- return 0
- }
- set sysV [BrowserProcs::id2obj $sysVId SystemVersion $node]
-
- # Import GroupVersion
- set myConfV [$node getParent ConfigVersion]
- set confVId [lindex $context 1]
- set confV [BrowserProcs::id2obj $confVId ConfigVersion $node]
- if {"$type" == "GroupVersion"} {
- set dstType [[$this phase] type]
- set srcType [[$sysV phase] type]
- if {"$srcType" != "$dstType" &&
- ("$srcType" == "Implementation" ||
- "$dstType" == "Implementation")} {
- wmtkmessage "Can not import '$type' from '$srcType' to '$dstType'"
- if [isCommand [.main undoCommand]] {
- [.main undoCommand] delete
- }
- return 0
- }
- set groupVId [lindex $context 4]
- set groupV [BrowserProcs::id2obj $groupVId GroupVersion $node]
-
- # Make sure GroupVersion exists
- if [catch {$groupV group}] {
- wmtkinfo \
- "Can not import [lindex $context 5] because it is removed"
- if [isCommand [.main undoCommand]] {
- [.main undoCommand] delete
- }
- return 1
- }
- $this copyGroupVersion $groupV $sysV $confV $myConfV
-
- return 1
- }
- }
-
- method SysVDbObj::importObjects {this contextList node} {
-
- set context [lindex $contextList 0]
-
- # just pick one configId and systemId of the dropped files,
- # they will all be the same
- set confVId [lindex $context 1]
- set sysVId [lindex $context 3]
- if {$sysVId == [$this getInfo Identity]} {
- wmtkmessage "Can not import object into its own parent"
- if [isCommand [.main undoCommand]] {
- [.main undoCommand] delete
- }
- return 0
- }
- set sysV [BrowserProcs::id2obj $sysVId SystemVersion $node]
-
- # Remove imported object in case of a cut operation
- set editPasteCmdBusy [.main undoCommandBusy EditPasteCmd]
- if {$editPasteCmdBusy && "[[.main undoCommand] operation]" == "cut"} {
- set cutIt 1
- } else {
- set cutIt 0
- }
-
- set copyList ""
- foreach context $contextList {
- # Import FileVersion
- set fileVId [lindex $context 4]
- set fileV [BrowserProcs::id2obj $fileVId FileVersion $node]
-
- # Make sure FileVersion exists
- if [catch {$fileV file}] {
- set name [lindex $context 5]
- wmtkinfo "Can not import $name because it is removed"
- continue
- }
- lappend copyList $fileV
- }
-
- if {$copyList == ""} {
- if [isCommand [.main undoCommand]] {
- [.main undoCommand] delete
- }
- return 1
- }
-
- set sourceContext [BrowserProcs::id2obj $confVId ConfigVersion $node]
-
- if $cutIt {
- $this moveFileVersions $sysV \
- $sourceContext -fileVersion $copyList $editPasteCmdBusy
- } else {
- $this copyFileVersions $sysV \
- $sourceContext -fileVersion $copyList $editPasteCmdBusy
-
- }
- return 1
- }
-
- proc SysVDbObj::infoProperties {} {
- return [concat \
- [BrowserProcs::infoProperties] \
- {Status Link Version Comments Created Updated Frozen \
- "Controlled Actions" "Created By" "Updated By"} \
- ]
- }
-
- method SysVDbObj::initializeInfo {this dummy} {
- set oldLink [[$this info] set PhaseSystemLink]
- [$this info] contents ""
- $this setInfo PhaseSystemLink $oldLink
- }
-
- method SysVDbObj::linkStatus {this} {
- return [[[$this info] set PhaseSystemLink] status]
- }
-
- method SysVDbObj::localFileVersions {this} {
- global SysVDbObj::this
- set SysVDbObj::this $this
- set localFileVersions ""
- foreach link [$this fileVersionLinks] {
- set fileV [$link fileVersion]
- $fileV setInfo SystemFileLink $link
- lappend localFileVersions $fileV
- }
- unset SysVDbObj::this
- return $localFileVersions
- }
-
- method SysVDbObj::localFileOnlyVersions {this} {
- set localFileOnlyVersions ""
- foreach fileV [$this localFileVersions] {
- if {"[$fileV getInfo Status]" == "reused"} continue
- lappend localFileOnlyVersions $fileV
- }
- return $localFileOnlyVersions
- }
-
- method SysVDbObj::makeUpToDate {this} {
- $this VersionObj::makeUpToDate
- }
-
- method SysVDbObj::moveFileVersions {this sourceSystem sourceConfig args} {
- # poor man's move: add implicitly selected files (copyspecs)
- # to copyList and deselect files after copying (in finalizeCopy)
- # after titanic a 'move' should be added to the server interface
- # and called here.
- set type [lindex $args 0]
- set fileVs [lindex $args 1]
- set editPasteCmdBusy [lindex $args 2]
- foreach cutFileV [.main cutFileVersions] {
- if { [lsearch -exact $fileVs $cutFileV] == -1 } {
- lappend fileVs $cutFileV
- }
- }
-
- foreach fileV $fileVs {
- $sourceSystem cutVersion $fileV
- }
-
- $this copyFileVersions $sourceSystem \
- $sourceConfig $type $fileVs $editPasteCmdBusy
- }
-
- method SysVDbObj::name {this} {
- return "[[$this system] name]"
- }
-
- method SysVDbObj::newObjects {this} {
- set script ""
- foreach obj [$wmttoolObj selectedObjSet] {
- if {"$script" != ""} {
- append script " ;"
- }
- if [$obj isA FileVersion] {
- set flag "-fileVersion"
- } elseif [$obj isA GroupVersion] {
- set flag "-groupVersion"
- } else {
- set flag ""
- }
- append script " \
- set configV \[$obj getParent ConfigVersion\];\
- $this derive $flag $obj \$configV"
- }
- $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
- }
-
- method SysVDbObj::removeObjects {this} {
- set box $wmttoolObj.removeWarning
- ClassMaker::extend YesNoWarningDialog RemoveObjectsWarningDialog dbObj
- RemoveObjectsWarningDialog new $box \
- -title "Confirm Object Delete" \
- -message [BrowserProcs::removeMessage] \
- -dbObj $this \
- -noPressed {%this delete} \
- -yesPressed {
- set dbObj [%this dbObj]
- set script ""
- foreach obj [$wmttoolObj selectedObjSet] {
- if {"$script" != ""} {
- append script " ;"
- }
- append script " $dbObj removeObject $obj"
- }
- $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
- %this delete
- }
- $box delCancelButton
- $box popUp
- }
-
- method SysVDbObj::removeVersion {this} {
- set versionList ""
- foreach version [[$this system] systemVersions] {
- if [$version isLeaf] {
- lappend versionList $version
- }
- }
- BrowserProcs::removeVersion \
- "[$this getParent PhaseVersion]" "[$this system]" $versionList
- }
-
- method SysVDbObj::reuse {this args} {
- set argc [llength $args]
- if {$argc <= 2} {
- eval $this SystemVersion::reuse $args
- return
- }
-
- set corpGV [lindex $args 0]
- set editPasteCmdBusy [lindex $args [expr $argc -1]]
- eval $this SystemVersion::reuse [lrange $args 0 [expr $argc -2]]
- if $editPasteCmdBusy {
- [.main undoCommand] addObject $corpGV
- }
- }
-
- method SysVDbObj::reused {this} {
- # empty
- }
-
- method SysVDbObj::selectObject {this mode} {
- busy {
- if [isCommand [[.main moduleHdlr] getModuleSpec corpmodelling]] {
- set corpmodelling 1
- } else {
- set corpmodelling 0
- }
-
- set versionList ""
- foreach fileV [$this localFileVersions] {
- set workingList([$fileV file]) $fileV
- }
- if $corpmodelling {
- foreach groupV [$this groupVersions] {
- set workingList([$groupV group]) $groupV
- }
- }
- case "$mode" in {
- {new} {
- set fileList ""
- foreach file [[$this system] files] {
- if [info exists workingList($file)] continue
- lappend fileList $file
- }
- if $corpmodelling {
- set groupList ""
- foreach group [[$this system] groups] {
- if [info exists workingList($group)] continue
- lappend groupList $group
- }
- }
- }
- {default} {
- set fileList ""
- set groupList ""
- foreach obj [$wmttoolObj selectedObjSet] {
- if [$obj isA FileVersion] {
- lappend fileList [$obj file]
- } elseif [$obj isA GroupVersion] {
- lappend groupList [$obj group]
- }
- }
- }
- }
- foreach file $fileList {
- set fileName [$file qualifiedName :]
- if [info exists workingList($file)] {
- set working $workingList($file)
- } else {
- set working [ORB::nil]
- }
- foreach version [$file fileVersions] {
- if [$version isSame $working] continue
- set status [$version status]
- if {"$status" == "working" || "$status" == "reused"} continue
- lappend versionList [list $version "$fileName"]
- }
- }
- if $corpmodelling {
- foreach group $groupList {
- set groupName [$group name]
- if [info exists workingList($group)] {
- set working $workingList($group)
- } else {
- set working [ORB::nil]
- }
- foreach version [$group groupVersions] {
- if [$version isSame $working] continue
- if {"[$version status]" == "working"} continue
- lappend versionList [list $version "$groupName"]
- }
- }
- }
- BrowserProcs::selectObject $this $versionList $mode
- }
- }
-
- method SysVDbObj::system {this} {
- if {[catch {set system [[[$this info] set PhaseSystemLink] system]}] ||
- [$system isNil]} {
- global errorInfo
- set errorInfo ""
- global errorCode
- set errorCode ""
- return [$this SystemVersion::system]
- }
- return $system
- }
-
- # Do not delete this line -- regeneration end marker
-
-