home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1997 November
/
PCWorld_1997-11_cd.bin
/
software
/
programy
/
komix
/
DATA.Z
/
sfileldbob.tcl
< prev
next >
Wrap
Text File
|
1996-10-08
|
8KB
|
287 lines
#---------------------------------------------------------------------------
#
# (c) Cadre Technologies Inc. 1996
#
# File: @(#)sfileldbob.tcl /main/hindenburg/1
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)sfileldbob.tcl /main/hindenburg/1 8 Oct 1996 Copyright 1996 Cadre Technologies Inc.
# Start user added include file section
# End user added include file section
require "browsdbobj.tcl"
Class SFileLDbObj : {SystemFileReference BrowsDbObj} {
method destructor
constructor
method browserType
method browserObjType
method compareVersion
method compareVersionAllowed
method editFile
method hasChildren
method initializeInfo
method pathName
method previewFile
method referredFileVersion
method referredSystemVersion
method selectFixed
method showFile
method versionName
}
method SFileLDbObj::destructor {this} {
# Start destructor user section
# End destructor user section
$this BrowsDbObj::destructor
}
constructor SFileLDbObj {class this name} {
set this [SystemFileReference::constructor $class $this $name]
set this [BrowsDbObj::constructor $class $this $name]
return $this
}
selfPromoter SystemFileReference {this} {
SFileLDbObj promote $this
}
proc SFileLDbObj::associations {} {
return {accessRuleSet}
}
method SFileLDbObj::browserType {this} {
return "[$this type]"
}
method SFileLDbObj::browserObjType {this} {
return "SFileLDbObj"
}
proc SFileLDbObj::childTypes {assoc} {
if {[lsearch -exact "[SFileLDbObj::associations]" "$assoc"] == -1} {
return ""
}
return "[BrowserProcs::childTypes $assoc]"
}
method SFileLDbObj::compareVersion {this} {
set versionList ""
set fileV [[$this info] set FileVersion]
foreach version [[$fileV file] fileVersions] {
if {"$version" == "$fileV"} continue
lappend versionList $version
}
BrowserProcs::compareVersion $fileV [$fileV file] $versionList
}
method SFileLDbObj::compareVersionAllowed {this} {
if [[[$this info] set FileVersion] isNil] {
return 0
}
return 1
}
proc SFileLDbObj::controlledLists {} {
return ""
}
method SFileLDbObj::editFile {this} {
set fileV [[$this info] set FileVersion]
if {! [$fileV isNil]} {
if {[$fileV inCorporate] || "[$fileV status]" != "working"} {
$this showFile
return
}
if [$this isA DocSection] {
$this edit
} else {
set sysV [$this referredSystemVersion]
if [$sysV isNil] {
wmtkerror "Can not edit \
[$this getInfo Type] '[$this getInfo Name]':\n \
System '[[$this referredSystem] name]' is not \
selected within the current PhaseVersion"
return
}
set phaseV [$this getParent PhaseVersion]
set confV [$this getParent ConfigVersion]
$fileV editFile $confV $phaseV $sysV
}
}
}
method SFileLDbObj::hasChildren {this} {
return 1
}
proc SFileLDbObj::infoProperties {} {
return [concat \
[BrowserProcs::infoProperties] \
{Status Version "Controlled Actions" Path} \
]
}
method SFileLDbObj::initializeInfo {this dummy} {
[$this info] contents ""
$this setInfo FileVersion [$this referredFileVersion]
}
method SFileLDbObj::pathName {this} {
if {! [$this isA DocSection]} {
return ""
}
return "[path_name concat \
[[$this document] directory] [$this getPropertyValue fileSystemPath] \
]"
}
method SFileLDbObj::previewFile {this} {
if {! [$this isDocDirUpToDate]} {
set confVId [[$this getParent ConfigVersion] identity]
set sysVId [[$this getParent SystemVersion] identity]
set argsfile [args_file [$this identity]]
set args "updateDocDir $confVId $sysVId [list $argsfile]"
set cmd "\
if \[lindex \[$wmttoolObj exitStatusList\] 0\] {\
$this preview\
}"
$wmttoolObj startDocbatch mtool "$args" "$cmd" {0 0} 0
} else {
$this preview
}
}
method SFileLDbObj::referredFileVersion {this} {
set fileV [$this SystemFileReference::referredFileVersion]
if {! [$fileV isNil]} {
return $fileV
}
set confV [$this getParent ConfigVersion]
if {"$confV" == ""} {
set confV [[ClientContext::global] currentConfig]
}
if [$confV isNil] {
return $confV
}
return [[$this referredFile] selectedVersion $confV]
}
method SFileLDbObj::referredSystemVersion {this} {
set confV [$this getParent ConfigVersion]
if {"$confV" == ""} {
set confV [[ClientContext::global] currentConfig]
}
if [$confV isNil] {
return $confV
}
return [[$this referredSystem] selectedVersion $confV]
}
method SFileLDbObj::selectFixed {this} {
set versionList ""
set file [$this referredFile]
set fileV [[$this info] set FileVersion]
foreach version [$file fileVersions] {
if {"$version" == "$fileV"} continue
lappend versionList $version
}
if [lempty $versionList] {
wmtkinfo "There are no other versions to select from"
return
}
set headerSpecList {
{Version 25 ascii {increasing 1}}
{Status 14 ascii {increasing 2}}
{"Frozen date" 30 ascii {none}}
{Comments 50 ascii {none}}
}
set objectSpecList ""
foreach version $versionList {
set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
[$version uiClass] [$version browserType] \
]
if {"$typeSpec" != ""} {
set icon [$typeSpec smallIcon]
} else {
set icon ""
}
lappend objectSpecList [list $icon \
[$version versionName] \
[$version status] \
[$version freezeTime2String] \
[$version comments] \
]
}
require "browsviewd.tcl"
set box $wmttoolObj.selectFixed
ClassMaker::extend BrowsViewDialog SelectFixedBrowsViewDialog dbObj
SelectFixedBrowsViewDialog new $box \
-title "Select Fixed" \
-message "File '[$file name].[$file type]'" \
-headerSpecList $headerSpecList \
-objectSpecList $objectSpecList \
-objectList $versionList \
-dbObj $this \
-cancelPressed {%this delete} \
-okPressed {
set dbObj [%this dbObj]
set version [[lindex [[%this view] selectedSet] 0] object]
set script "$dbObj makeFixed $version"
if [$dbObj isA DocSection] {
set confVId [[$dbObj getParent ConfigVersion] identity]
set sysVId [[$dbObj getParent SystemVersion] identity]
set argsfile [args_file [$dbObj identity]]
set args "updateDocDir $confVId $sysVId [list $argsfile]"
set cmd \
"$wmttoolObj startDocbatch mtool [list $args] \"\" {0 0} 0"
} else {
set cmd ""
}
$wmttoolObj startCommand tcl "$script" "$cmd" "" {1 0} 1
%this delete
}
[$box view] selectionPolicy BROWSE
$box popUp
}
method SFileLDbObj::showFile {this} {
set fileV [[$this info] set FileVersion]
if {! [$fileV isNil]} {
if [$this isA DocSection] {
$this show
} else {
set sysV [$this referredSystemVersion]
if [$sysV isNil] {
wmtkerror "Can not show \
[$this getInfo Type] '[$this getInfo Name]':\n \
System '[[$this referredSystem] name]' is not \
selected within the current PhaseVersion"
return
}
set phaseV [$this getParent PhaseVersion]
set confV [$this getParent ConfigVersion]
$fileV showFile $confV $phaseV $sysV
}
}
}
method SFileLDbObj::versionName {this} {
set fileV [[$this info] set FileVersion]
if [$fileV isNil] {
return ""
}
return [$fileV versionName]
}
# Do not delete this line -- regeneration end marker