home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / projdbobj.tcl < prev    next >
Text File  |  1996-10-14  |  5KB  |  185 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)projdbobj.tcl    /main/hindenburg/2
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)projdbobj.tcl    /main/hindenburg/2   14 Oct 1996 Copyright 1996 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "browsdbobj.tcl"
  15.  
  16. Class ProjDbObj : {BrowsDbObj Project} {
  17.     method destructor
  18.     constructor
  19.     method promoter
  20.     method activateObject
  21.     method addConfigVersion
  22.     method deactivateObject
  23.     method deselectVersion
  24.     method newObjects
  25.     method removeObjects
  26.     method selectVersion
  27.     attribute roleSet
  28.     attribute controlledClassSet
  29. }
  30.  
  31. method ProjDbObj::destructor {this} {
  32.     # Start destructor user section
  33.  
  34.     [$this customFileVersionSet] delete
  35.     [$this controlledClassSet] delete
  36.     [$this controlledListSet] delete
  37.     [$this roleSet] delete
  38.  
  39.     # End destructor user section
  40.     $this BrowsDbObj::destructor
  41. }
  42.  
  43. constructor ProjDbObj {class this name} {
  44.     set this [Project::constructor $class $this $name]
  45.     set this [BrowsDbObj::constructor $class $this $name]
  46.     return $this
  47. }
  48.  
  49. selfPromoter Project {this} {
  50.     ProjDbObj promote $this
  51. }
  52.  
  53. method ProjDbObj::promoter {this} {
  54.     $this BrowsDbObj::promoter
  55.  
  56.     set customFileVersionSet $this.${CustFVUiObj::uiClass}:0
  57.     if {! [isCommand $customFileVersionSet]} {
  58.     CustFVUiObj new $customFileVersionSet -parent $this
  59.     }
  60.     $this customFileVersionSet $customFileVersionSet
  61.     set controlledClassSet $this.${CClassUiObj::uiClass}:0
  62.     if {! [isCommand $controlledClassSet]} {
  63.     CClassUiObj new $controlledClassSet -parent $this
  64.     }
  65.     $this controlledClassSet $controlledClassSet
  66.     set controlledListSet $this.${CListUiObj::uiClass}:0
  67.     if {! [isCommand $controlledListSet]} {
  68.     CListUiObj new $controlledListSet -parent $this
  69.     }
  70.     $this controlledListSet $controlledListSet
  71.     set roleSet $this.${RoleUiObj::uiClass}:0
  72.     if {! [isCommand $roleSet]} {
  73.     RoleUiObj new $roleSet -parent $this
  74.     }
  75.     $this roleSet $roleSet
  76. }
  77.  
  78. method ProjDbObj::activateObject {this} {
  79.     set obj [lindex [$wmttoolObj selectedObjSet] 0]
  80.     set script "$obj activate"
  81.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  82. }
  83.  
  84. method ProjDbObj::addConfigVersion {this} {
  85.     require "newobjentr.tcl"
  86.  
  87.     if {! [isCommand $wmttoolObj.newConfigV]} {
  88.     NewObjEntryDlg new $wmttoolObj.newConfigV \
  89.         -title "New Config Version" \
  90.         -message "Configuration Name:" \
  91.         -okPressed {
  92.         set confName [%this entry]
  93.         set script "[%this dbObj] createConfigVersion [list $confName]"
  94.         $wmttoolObj startCommand tcl \
  95.             "$script" "" \
  96.             "Creating configuration version '$confName'..." \
  97.             {1 0} 1
  98.         }
  99.     }
  100.     $wmttoolObj.newConfigV dbObj $this
  101.     $wmttoolObj.newConfigV popUp
  102. }
  103.  
  104. proc ProjDbObj::associations {} {
  105.     return {\
  106.     configVersions customFileVersionSet controlledClassSet \
  107.     controlledListSet accessRuleSet roleSet\
  108.     }
  109. }
  110.  
  111. proc ProjDbObj::childTypes {assoc} {
  112.     if {[lsearch -exact "[ProjDbObj::associations]" "$assoc"] == -1} {
  113.     return ""
  114.     }
  115.     return "[BrowserProcs::childTypes $assoc]"
  116. }
  117.  
  118. proc ProjDbObj::controlledLists {} {
  119.     return {
  120.     "[$this configList]"
  121.     "[$this customFileList]"
  122.     "[$this customFileVersionLinkList]"
  123.     "[$this phaseList]"
  124.     }
  125. }
  126.  
  127. method ProjDbObj::deactivateObject {this} {
  128.     set obj [lindex [$wmttoolObj selectedObjSet] 0]
  129.     set script "$obj deactivate"
  130.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  131. }
  132.  
  133. method ProjDbObj::deselectVersion {this version} {
  134.     $this deselect $version
  135. }
  136.  
  137. proc ProjDbObj::infoProperties {} {
  138.     return [concat \
  139.     [BrowserProcs::infoProperties] \
  140.     {"Controlled Actions"} \
  141.     ]
  142. }
  143.  
  144. method ProjDbObj::newObjects {this} {
  145.     set script ""
  146.     foreach obj [$wmttoolObj selectedObjSet] {
  147.     if {"$script" != ""} {
  148.         append script " ;"
  149.     }
  150.     append script " $obj derive -self"
  151.     }
  152.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  153. }
  154.  
  155. method ProjDbObj::removeObjects {this} {
  156.     set box $wmttoolObj.removeWarning
  157.     ClassMaker::extend WarningDialog RemoveObjectsWarningDialog dbObj
  158.     RemoveObjectsWarningDialog new $box \
  159.     -title "Delete Warning" \
  160.     -message [BrowserProcs::removeMessage] \
  161.     -dbObj $this \
  162.     -helpPressed {.main helpOnName removeWarning} \
  163.     -cancelPressed {%this delete} \
  164.     -okPressed {
  165.         set dbObj [%this dbObj]
  166.         set script ""
  167.         foreach obj [$wmttoolObj selectedObjSet] {
  168.         if {"$script" != ""} {
  169.             append script " ;"
  170.         }
  171.         append script " $dbObj removeObject $obj"
  172.         }
  173.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  174.         %this delete
  175.     }
  176.     $box popUp
  177. }
  178.  
  179. method ProjDbObj::selectVersion {this version} {
  180.     $this select $version
  181. }
  182.  
  183. # Do not delete this line -- regeneration end marker
  184.  
  185.