home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / svdgvdbobj.tcl < prev    next >
Encoding:
Text File  |  1996-10-30  |  5.3 KB  |  224 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)svdgvdbobj.tcl    /main/hindenburg/2
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)svdgvdbobj.tcl    /main/hindenburg/2   30 Oct 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "browsdbobj.tcl"
  15.  
  16. Class SvdGVDbObj : {BrowsDbObj SavedGroupVersion} {
  17.     method destructor
  18.     constructor
  19.     method createdBy
  20.     method inCorporate2String
  21.     method makeCorporate
  22.     method makeCorporateAllowed
  23.     method name
  24.     method newObjects
  25.     method phaseName
  26.     method printObjects
  27.     method projectName
  28.     method removeObjects
  29.     method removeVersion
  30.     method systemName
  31.     method versionInLabel
  32.     method versionName
  33. }
  34.  
  35. method SvdGVDbObj::destructor {this} {
  36.     # Start destructor user section
  37.     # End destructor user section
  38.     $this BrowsDbObj::destructor
  39. }
  40.  
  41. constructor SvdGVDbObj {class this name} {
  42.     set this [SavedGroupVersion::constructor $class $this $name]
  43.     set this [BrowsDbObj::constructor $class $this $name]
  44.     return $this
  45. }
  46.  
  47. selfPromoter SavedGroupVersion {this} {
  48.     SvdGVDbObj promote $this
  49. }
  50.  
  51. proc SvdGVDbObj::associations {} {
  52.     return {fileVersions accessRuleSet}
  53. }
  54.  
  55. proc SvdGVDbObj::childTypes {assoc} {
  56.     if {[lsearch -exact "[SvdGVDbObj::associations]" "$assoc"] == -1} {
  57.     return ""
  58.     }
  59.     set childTypes [BrowserProcs::childTypes $assoc]
  60.     case "$childTypes" in {
  61.     {FileVersion} {
  62.         return [concat \
  63.         ${BrowserProcs::diagramFileTypes} \
  64.         ${BrowserProcs::programmerFileTypes}]
  65.     }
  66.     {default} {
  67.         return "$childTypes"
  68.     }
  69.     }
  70. }
  71.  
  72. proc SvdGVDbObj::controlledLists {} {
  73.     return ""
  74. }
  75.  
  76. method SvdGVDbObj::createdBy {this} {
  77.     return [[$this creator] name]
  78. }
  79.  
  80. method SvdGVDbObj::inCorporate2String {this} {
  81.     if [[$this corporateGroupVersion] isNil] {
  82.     return "No"
  83.     }
  84.     return "Yes"
  85. }
  86.  
  87. proc SvdGVDbObj::infoProperties {} {
  88.     return [concat \
  89.     [BrowserProcs::infoProperties] \
  90.     {Version Comments Created "Created By" "In Corporate" \
  91.      Project Phase System "Controlled Actions"} \
  92.     ]
  93. }
  94.  
  95. method SvdGVDbObj::makeCorporate {this} {
  96.     require "newobjentr.tcl"
  97.  
  98.     set box $wmttoolObj.makeCorporate
  99.     NewObjEntryDlg new $box \
  100.     -title "Make Corporate" \
  101.     -message "Corporate Group Name:" \
  102.     -dbObj $this \
  103.     -cancelPressed {%this delete} \
  104.     -okPressed {
  105.         set name [%this entry]
  106.         set comments [%this.top.comments text]
  107.         set script "[%this dbObj] toCorporate [list $comments] [list $name]"
  108.         $wmttoolObj startCommand tcl \
  109.         "$script" "" \
  110.         "Creating corporate group version '$name'..." \
  111.         {1 0} 1
  112.         %this delete
  113.     }
  114.     Label new $box.top.commentsLab \
  115.     -text "Comments:"
  116.     SingleLineText new $box.top.comments
  117.  
  118.     set corpG [[$this savedGroup] corporateGroup]
  119.     if [$corpG isNil] {
  120.     $box entry "[$this name]"
  121.     $box.top.name sensitive 1
  122.     } else {
  123.     $box entry "[$corpG name]"
  124.     $box.top.name sensitive 0
  125.     }
  126.     $box popUp
  127. }
  128.  
  129. method SvdGVDbObj::makeCorporateAllowed {this} {
  130.     if {! [[$this corporateGroupVersion] isNil]} {
  131.     return 0
  132.     }
  133.  
  134.     set sysV [$this getParent SystemVersion]
  135.     if {"$sysV" == ""} {
  136.     return 0
  137.     }
  138.     if {[$sysV getInfo Status] == "backGround"} {
  139.     return 0
  140.     }
  141.  
  142.     return 1
  143. }
  144.  
  145. method SvdGVDbObj::name {this} {
  146.     return "[[$this savedGroup] name]"
  147. }
  148.  
  149. method SvdGVDbObj::newObjects {this} {
  150.     set sysV [$this getParent SystemVersion]
  151.     if {"$sysV" == ""} {
  152.     wmtkerror "Cannot access corporate FileVersion(s)"
  153.     return
  154.     }
  155.     $sysV newObjects
  156. }
  157.  
  158. method SvdGVDbObj::phaseName {this} {
  159.     return [[[$this system] phase] name]
  160. }
  161.  
  162. method SvdGVDbObj::printObjects {this} {
  163.     set asciiFiles ""
  164.     set topostObjects ""
  165.     foreach obj [$wmttoolObj selectedObjSet] {
  166.     if [$obj isA Graph] {
  167.         lappend topostObjects $obj
  168.     } elseif [$obj isA ExternalFileVersion] {
  169.         $obj synchWithFileSystem
  170.         lappend asciiFiles [$obj path]
  171.     }
  172.     }
  173.     BrowserProcs::printObjects $asciiFiles "" $topostObjects
  174. }
  175.  
  176. method SvdGVDbObj::projectName {this} {
  177.     return [[$this project] name]
  178. }
  179.  
  180. method SvdGVDbObj::removeObjects {this} {
  181.     set sysV [$this getParent SystemVersion]
  182.     if {"$sysV" == ""} {
  183.     wmtkerror "Cannot access corporate FileVersion(s)"
  184.     return
  185.     }
  186.     $sysV removeObjects
  187. }
  188.  
  189. method SvdGVDbObj::removeVersion {this} {
  190.     set box $wmttoolObj.removeVersionWarning
  191.     WarningDialog new $box \
  192.     -title "Delete Version Warning" \
  193.     -message [BrowserProcs::removeMessage] \
  194.     -helpPressed {.main helpOnName removeVersionWarning} \
  195.     -cancelPressed {%this delete} \
  196.     -okPressed {
  197.         set script ""
  198.         foreach obj [$wmttoolObj selectedObjSet] {
  199.         if {"$script" != ""} {
  200.             append script " ;"
  201.         }
  202.         append script " [$obj savedGroup] removeVersion $obj"
  203.         }
  204.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  205.         %this delete
  206.     }
  207.     $box popUp
  208. }
  209.  
  210. method SvdGVDbObj::systemName {this} {
  211.     return [[$this system] name]
  212. }
  213.  
  214. method SvdGVDbObj::versionInLabel {this} {
  215.     return 1
  216. }
  217.  
  218. method SvdGVDbObj::versionName {this} {
  219.     return [$this versionNumber]
  220. }
  221.  
  222. # Do not delete this line -- regeneration end marker
  223.  
  224.