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