home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cayenne Software Inc. 1996
- #
- # File: @(#)s_ssysvdbo.tcl /main/titanic/3
- # Author: Marcel Bancken
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)s_ssysvdbo.tcl /main/titanic/3 16 Jun 1997 Copyright 1996 Cayenne Software Inc.
-
- require ssysvdbobj.tcl
-
- global SSysVDbObj_associations_corpmodelling
- set SSysVDbObj_associations_corpmodelling [SSysVDbObj::associations]
-
- proc SSysVDbObj::associations {} {
- set associations \
- [BrowserProcs::splitAssociations $SSysVDbObj_associations_corpmodelling]
- return [concat \
- [lindex $associations 0] {groupVersions} \
- [lindex $associations 1] {savedGroupVersionSet} \
- ]
- }
-
- method SSysVDbObj::addGroupVersion {this} {
- require_module_file newgroupvd.tcl corpmodelling
-
- set box .main.newGroupV
- if {! [isCommand $box]} {
- NewGroupVDlg new $box
- }
- $box dbObj $this
- $box popUp
- }
-
- method SSysVDbObj::savedGroupVersions {this} {
- set savedGroupVersions ""
- foreach savedGroup [[$this system] savedGroups] {
- set savedGroupVersions \
- [concat $savedGroupVersions [$savedGroup savedGroupVersions]]
- }
- return $savedGroupVersions
- }
-
- method SSysVDbObj::snapshotObjects {this} {
- set objList [.main selectedObjSet]
- if [lempty $objList] {
- return
- }
- foreach obj $objList {
- if {! [$obj isA GroupVersion]} {
- return
- }
- }
-
- set box .main.snapshotVersion
- if {! [isCommand $box]} {
- ClassMaker::extend EntryDialog SnapshotVEntryDialog {dbObj objList}
- SnapshotVEntryDialog new $box \
- -modal yes \
- -title "Snapshot" \
- -message "Comments:" \
- -helpPressed {.main helpOnName snapshotVersion} \
- -okPressed {
- set comments [%this entry]
- set dbObj [%this dbObj]
- set objList [%this objList]
- set script ""
- set confV [$dbObj getParent ConfigVersion]
- foreach obj $objList {
- if {"$script" != ""} {
- append script " ;"
- }
- append script \
- " $obj snapshot $dbObj $confV [list $comments]"
- }
- .main startCommand tcl "$script" "" "" {1 0} 1
- }
- }
- $box config \
- -dbObj $this \
- -objList $objList
- $box popUp
- }
-