home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1997 November
/
PCWorld_1997-11_cd.bin
/
software
/
programy
/
komix
/
DATA.Z
/
sysvdbobj.tcl
< prev
next >
Wrap
Text File
|
1996-11-18
|
23KB
|
827 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1996
#
# File: @(#)sysvdbobj.tcl /main/hindenburg/12
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)sysvdbobj.tcl /main/hindenburg/12 18 Nov 1996 Copyright 1996 Cayenne Software Inc.
# Start user added include file section
require "clistuiobj.tcl"
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 browserType
method changeLinks
method changeObjects
method copy
method copyGroupVersion
method copyVersion
method deactivateObject
method deselectObjects
method groupVersions
method importObject
method initializeInfo
method linkStatus
method localFileVersions
method name
method newObjects
method removeObjects
method removeVersion
method reuse
method selectObject
method system
attribute workItemSet
}
method SysVDbObj::destructor {this} {
# Start destructor user section
[$this customFileVersionSet] delete
[$this workItemSet] delete
[$this controlledListSet] delete
# 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"} {
DSysVDbObj 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 controlledListSet $this.${CListUiObj::uiClass}:0
if {! [isCommand $controlledListSet]} {
CListUiObj new $controlledListSet -parent $this
}
$this controlledListSet $controlledListSet
set workItemSet $this.${WItemUiObj::uiClass}:0
if {! [isCommand $workItemSet]} {
WItemUiObj new $workItemSet -parent $this
}
$this workItemSet $workItemSet
}
method SysVDbObj::activateObject {this} {
set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
CorporateGroupVersion "" \
]
if {"$typeSpec" != ""} {
set icon [$typeSpec smallIcon]
} else {
set icon ""
}
set headerSpecList {
{Name 25 ascii {increasing 1}}
{Version 8 ascii {increasing 2}}
{Created 30 ascii {none}}
{Comments 50 ascii {none}}
}
foreach corpGV [$this reused] {
set reusedList($corpGV) 1
}
set corpGVList ""
set objectSpecList ""
set corpGVSet [[$wmttoolObj corporateObj] corporateGroupVersionSet]
set srcType [[$this parent] getInfo Type]
foreach corpGV [$corpGVSet corporateGroupVersions] {
if [info exists reusedList($corpGV)] continue
set dstType [[[[$corpGV savedGroupVersion] system] phase] type]
if {"$srcType" != "$dstType" &&
("$srcType" == "Implementation" ||
"$dstType" == "Implementation")} continue
lappend corpGVList $corpGV
lappend objectSpecList [list $icon \
[[$corpGV corporateGroup] name] \
[$corpGV versionNumber] \
[$corpGV createTime2String] \
[$corpGV comments] \
]
}
if [lempty $corpGVList] {
wmtkinfo \
"There are no unused CoporateGroups that can be activated\
within this SystemVersion"
return
}
require "browsviewd.tcl"
set box $wmttoolObj.activate
ClassMaker::extend BrowsViewDialog ActivateBrowsViewDialog dbObj
ActivateBrowsViewDialog new $box \
-title "Activate Corporate Group" \
-headerSpecList $headerSpecList \
-objectSpecList $objectSpecList \
-objectList $corpGVList \
-dbObj $this \
-cancelPressed {%this delete} \
-okPressed {
set dbObj [%this dbObj]
set confV [$dbObj getParent ConfigVersion]
set script ""
foreach object [[%this view] selectedSet] {
set corpGV [$object object]
if {"$script" != ""} {
append script " ;"
}
append script " $dbObj reuse $corpGV $confV"
}
$wmttoolObj startCommand tcl \
"$script" "" \
"Activating CorporateGroupVersion(s)..." \
{1 0} 1
%this delete
}
$box popUp
}
method SysVDbObj::browserType {this} {
set systemType [[$this system] type]
set firstChar [string toupper [string range $systemType 0 0]]
set type "${firstChar}[string range $systemType 1 end]"
return "${type}Version"
}
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
}
method SysVDbObj::changeObjects {this status} {
case "$status" in {
{fixed} {
set operation "makeFixed"
}
{selected} {
set operation "makeSelected"
}
{snapshot} {
set operation "makeSnapshot"
}
{current} {
set operation "makeCurrent"
}
{default} {
return
}
}
set objectList [$wmttoolObj selectedObjSet]
set script ""
set sections ""
foreach obj $objectList {
if {"$script" != ""} {
append script " ;"
}
append script " $obj $operation"
if [$obj isA DocSection] {
lappend sections [$obj identity]
}
}
if [lempty $sections] {
set cmd ""
} else {
case "$status" in {
{selected current} {
set confVId [[$this getParent ConfigVersion] identity]
set sysVId [$this identity]
set argsfile [args_file $sections]
set args "updateDocDir $confVId $sysVId [list $argsfile]"
set cmd \
"$wmttoolObj startDocbatch mtool [list $args] \"\" {0 0} 0"
}
{default} {
set cmd ""
}
}
}
$wmttoolObj startCommand tcl "$script" "$cmd" "" {1 0} 1
}
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 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 fileName [$fileV name "/"]
set fileType [[$fileV file] type]
set oldFileV [$this findFileVersion $fileName $fileType]
if {! [$oldFileV isNil]} {
$this deselectVersion $oldFileV
if $editPasteCmdBusy {
[.main undoCommand] addDeselected $oldFileV
}
}
set newFileV [eval \
$this SystemVersion::copy [lrange $args 0 [expr $argc -2]]]
if {$editPasteCmdBusy && (! [$newFileV isNil])} {
[.main undoCommand] addObject $newFileV
}
}
{-groupVersion} {
if {$argc <= 6} {
eval $this SystemVersion::copy $args
break
}
set groupV [lindex $args 1]
set mode [lindex $args 5]
set editPasteCmdBusy [lindex $args [expr $argc -1]]
if {"$mode" == "definition" || "$mode" == "all"} {
set groupName [$groupV name]
set oldGroupV [$this findGroupVersion $groupName]
if {! [$oldGroupV isNil]} {
$this deselectVersion $oldGroupV
if $editPasteCmdBusy {
[.main undoCommand] addDeselected $oldGroupV
}
}
}
if {"$mode" == "contents" || "$mode" == "all"} {
set fromSysV [lindex $args 2]
set fromConfV [lindex $args 3]
set contents [$groupV selectorEngine $fromSysV $fromConfV]
set fileVList ""
foreach fileV $contents {
if [$fileV isA FileVersion] {
lappend fileVList $fileV
set file [$fileV file]
set fileName [$fileV name "/"]
set fileType [$file type]
set oldFileV [$this findFileVersion $fileName $fileType]
if {! [$oldFileV isNil]} {
$this deselectVersion $oldFileV
if $editPasteCmdBusy {
[.main undoCommand] addDeselected $oldFileV
}
}
}
}
}
eval $this SystemVersion::copy [lrange $args 0 [expr $argc -2]]
if $editPasteCmdBusy {
if {"$mode" == "definition" || "$mode" == "all"} {
set newGroupV [$this findGroupVersion $groupName]
if {! [$newGroupV isNil]} {
[.main undoCommand] addObject $newGroupV
}
}
if {"$mode" == "contents" || "$mode" == "all"} {
foreach fileV $fileVList {
set file [$fileV file]
set fileName [$fileV name "/"]
set fileType [$file type]
set newFileV [$this findFileVersion $fileName $fileType]
if {! [$newFileV isNil]} {
[.main undoCommand] addObject $newFileV
}
}
}
}
}
{default} {
eval $this SystemVersion::copy $args
}
}
}
method SysVDbObj::copyGroupVersion {this groupV fromSysV fromConfV toConfV} {
require "copygroupv.tcl"
global classCount
incr classCount
set box $wmttoolObj.copyGroupVersion$classCount
CopyGroupVDlg new $box \
-dbObj $this \
-groupV $groupV \
-fromSysV $fromSysV \
-fromConfV $fromConfV \
-toConfV $toConfV
$box popUp
}
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} {
set corpGVList [$this reused]
if [lempty $corpGVList] {
wmtkinfo \
"There are no CorporateGroups activated within this SystemVersion"
return
}
set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
CorporateGroupVersion "" \
]
if {"$typeSpec" != ""} {
set icon [$typeSpec smallIcon]
} else {
set icon ""
}
set headerSpecList {
{Name 25 ascii {increasing 1}}
{Version 8 ascii {increasing 2}}
{Created 30 ascii {none}}
{Comments 50 ascii {none}}
}
set objectSpecList ""
foreach corpGV $corpGVList {
lappend objectSpecList [list $icon \
[[$corpGV corporateGroup] name] \
[$corpGV versionNumber] \
[$corpGV createTime2String] \
[$corpGV comments] \
]
}
require "browsviewd.tcl"
set box $wmttoolObj.deactivate
ClassMaker::extend BrowsViewDialog DeactivateBrowsViewDialog dbObj
DeactivateBrowsViewDialog new $box \
-title "Deactivate Corporate Group" \
-headerSpecList $headerSpecList \
-objectSpecList $objectSpecList \
-objectList $corpGVList \
-dbObj $this \
-cancelPressed {%this delete} \
-okPressed {
set dbObj [%this dbObj]
set script ""
foreach object [[%this view] selectedSet] {
set corpGV [$object object]
if {"$script" != ""} {
append script " ;"
}
append script " $dbObj unuse $corpGV"
}
$wmttoolObj startCommand tcl \
"$script" "" \
"Deactivating CorporateGroupVersion(s)..." \
{1 0} 1
%this delete
}
$box popUp
}
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
}
method SysVDbObj::groupVersions {this} {
set groupVersions ""
foreach link [$this groupVersionLinks] {
set groupV [$link groupVersion]
$groupV setInfo SystemGroupLink $link
lappend groupVersions $groupV
}
return $groupVersions
}
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
}
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
}
} else {
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
}
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
}
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
}
} else {
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
}
$this copyGroupVersion $groupV $sysV $confV $myConfV
}
return
}
# Import FileVersion
set fileVId [lindex $context 4]
set fileV [BrowserProcs::id2obj $fileVId FileVersion $node]
# Make sure FileVersion exists
if [catch {$fileV file}] {
wmtkinfo "Can not import [lindex $context 5] because it is removed"
if [isCommand [.main undoCommand]] {
[.main undoCommand] delete
}
return
}
# Remove imported object in case of a cut operation
set editPasteCmdBusy [.main undoCommandBusy EditPasteCmd]
if {$editPasteCmdBusy &&
"[[.main undoCommand] operation]" == "cut"} {
$sysV cutVersion $fileV
}
set script "$this copy -fileVersion $fileV $myConfV $editPasteCmdBusy"
$wmttoolObj startCommand tcl \
"$script" "" \
"Copying [$fileV getInfo Text]" \
[list $update 0] 1
}
proc SysVDbObj::infoProperties {} {
return [concat \
[BrowserProcs::infoProperties] \
{Status Link Version Comments Created Updated Frozen \
"Controlled Actions" "Created 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::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 WarningDialog RemoveObjectsWarningDialog dbObj
RemoveObjectsWarningDialog new $box \
-title "Delete Warning" \
-message [BrowserProcs::removeMessage] \
-dbObj $this \
-helpPressed {.main helpOnName removeWarning} \
-cancelPressed {%this delete} \
-okPressed {
set dbObj [%this dbObj]
set script ""
foreach obj [$wmttoolObj selectedObjSet] {
if {"$script" != ""} {
append script " ;"
}
append script " $dbObj removeObject $obj"
if {[$obj isA FileRefSection] || [$obj isA PropertySection]} {
append script " ;"
append script " catch [list \
[list BasicFS::removeFile [$obj docLocation]]]"
}
}
$wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
%this delete
}
$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::selectObject {this mode} {
set versionList ""
foreach fileV [$this localFileVersions] {
set workingList([$fileV file]) $fileV
}
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
}
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"]
}
}
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