home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cadre Technologies Inc. 1996
- #
- # File: @(#)custfvdbob.tcl /main/hindenburg/3
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)custfvdbob.tcl /main/hindenburg/3 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 CustFVDbObj : {BrowsDbObj CustomFileVersion VersionObj} {
- method destructor
- constructor
- method promoter
- method browserType
- method compareVersion
- method compareVersionAllowed
- method copyVersion
- method editFile
- method hasChildren
- method name
- method openFile
- method removeVersion
- method showFile
- method typeInLabel
- }
-
- method CustFVDbObj::destructor {this} {
- # Start destructor user section
-
- [$this controlledListSet] delete
-
- # End destructor user section
- $this BrowsDbObj::destructor
- $this VersionObj::destructor
- }
-
- constructor CustFVDbObj {class this name} {
- set this [CustomFileVersion::constructor $class $this $name]
- set this [BrowsDbObj::constructor $class $this $name]
- set this [VersionObj::constructor $class $this $name]
- return $this
- }
-
- selfPromoter CustomFileVersion {this} {
- CustFVDbObj promote $this
- }
-
- method CustFVDbObj::promoter {this} {
- $this BrowsDbObj::promoter
-
- set controlledListSet $this.${CListUiObj::uiClass}:0
- if {! [isCommand $controlledListSet]} {
- CListUiObj new $controlledListSet -parent $this
- }
- $this controlledListSet $controlledListSet
- }
-
- proc CustFVDbObj::associations {} {
- return {controlledListSet accessRuleSet}
- }
-
- method CustFVDbObj::browserType {this} {
- return "[[$this customFile] type]"
- }
-
- proc CustFVDbObj::childTypes {assoc} {
- if {[lsearch -exact "[CustFVDbObj::associations]" "$assoc"] == -1} {
- return ""
- }
- return "[BrowserProcs::childTypes $assoc]"
- }
-
- method CustFVDbObj::compareVersion {this} {
- set versionList ""
- foreach version [[$this customFile] customFileVersions] {
- if {"$version" == "$this"} continue
- lappend versionList $version
- }
- BrowserProcs::compareVersion $this [$this customFile] $versionList
- }
-
- method CustFVDbObj::compareVersionAllowed {this} {
- return 1
- }
-
- proc CustFVDbObj::controlledLists {} {
- return {"[[$this customFile] customFileVersionList]"}
- }
-
- method CustFVDbObj::copyVersion {this} {
- set versionList ""
- set myType [$this browserType]
- set myName [$this name]
- foreach custf [[[$this customFile] customLevel] customFiles] {
- if {"[$custf name]" != "$myName"} continue
- if {"[$custf type]" != "$myType"} continue
- foreach version [$custf customFileVersions] {
- if {"$version" == "$this"} continue
- lappend versionList [list $version "$myName.$myType"]
- }
- }
- BrowserProcs::copyVersion $this $versionList
- }
-
- method CustFVDbObj::editFile {this} {
- if {"[$this getInfo Status]" != "working"} {
- $this showFile
- return
- }
- case "[$this browserType]" in {
- {mnu vie objtype opendefs openlocs propdefs proplocs} {
- set script "SystemUtilities::fork otk uce \
- -c [list [get_comm_name]] \
- -id [$this getInfo Identity]"
- $wmttoolObj startCommand tcl \
- "$script" "" \
- "Starting uce for '[$this name].[$this browserType]'" \
- {0 0} 1
- }
- {pnl} {
- require "ctrlpnldia.tcl"
- global classCount
- incr classCount
- set dlgName .main.ctrlPnlDialog$classCount
- CtrlPnlDialog new $dlgName \
- -helpPressed ".main helpOnName ctrlPnlDialog" \
- -lvlObj [$this getParent CustomLevelVersion] \
- -fileName [$this name] \
- -fileType [$this browserType] \
- -editable 1
- $dlgName popUp
- }
- {default} {
- case "[$this name]" in {
- {checkconfig} {
- require "custcheckd.tcl"
- global classCount
- incr classCount
- set dlgName .main.custCheckDialog$classCount
- CustCheckDialog new $dlgName
- $dlgName edit [$this getParent CustomLevelVersion]
- }
- {default} {
- $this edit
- set tmpFile [args_file {}]
- $this downLoad $tmpFile
- set cmd [list $this upLoad $tmpFile]
- append cmd " ;"
- append cmd " $this quit"
- append cmd " ;"
- append cmd [list BasicFS::removeFile $tmpFile]
- $wmttoolObj startM4Command \
- editor $tmpFile "$cmd" "[$this name]"
- }
- }
- }
- }
- }
-
- method CustFVDbObj::hasChildren {this} {
- return 1
- }
-
- proc CustFVDbObj::infoProperties {} {
- return [concat \
- [BrowserProcs::infoProperties] \
- {Status Version Comments Created Updated Frozen "Controlled Actions"
- "Created By"} \
- ]
- }
-
- method CustFVDbObj::name {this} {
- return "[[$this customFile] name]"
- }
-
- method CustFVDbObj::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 CustFVDbObj::removeVersion {this} {
- set versionList ""
- foreach version [[$this customFile] customFileVersions] {
- if [$version isLeaf] {
- lappend versionList $version
- }
- }
- BrowserProcs::removeVersion \
- "[$this getParent CustomLevelVersion]" \
- "[$this customFile]" "$versionList"
- }
-
- method CustFVDbObj::showFile {this} {
- case "[$this browserType]" in {
- {mnu vie objtype opendefs openlocs propdefs proplocs} {
- set script "SystemUtilities::fork otk uce -r \
- -c [list [get_comm_name]] \
- -id [$this getInfo Identity]"
- $wmttoolObj startCommand tcl \
- "$script" "" \
- "Starting uce for '[$this name].[$this browserType]'" \
- {0 0} 1
- }
- {pnl} {
- require "ctrlpnldia.tcl"
- global classCount
- incr classCount
- set dlgName .main.ctrlPnlDialog$classCount
- CtrlPnlDialog new $dlgName \
- -helpPressed ".main helpOnName ctrlPnlDialog" \
- -lvlObj [$this getParent CustomLevelVersion] \
- -fileName [$this name] \
- -fileType [$this browserType] \
- -editable 0
- $dlgName popUp
- }
- {default} {
- case "[$this name]" in {
- {checkconfig} {
- require "custcheckd.tcl"
- global classCount
- incr classCount
- set dlgName .main.custCheckDialog$classCount
- CustCheckDialog new $dlgName
- $dlgName show [$this getParent CustomLevelVersion]
- }
- {default} {
- set tmpFile [args_file {}]
- $this downLoad $tmpFile
- set cmd [list BasicFS::removeFile $tmpFile]
- $wmttoolObj startM4Command \
- viewer $tmpFile "$cmd" "[$this name]"
- }
- }
- }
- }
- }
-
- method CustFVDbObj::typeInLabel {this} {
- return 1
- }
-
- # Do not delete this line -- regeneration end marker
-
-