home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / phasevdbob.tcl < prev    next >
Encoding:
Text File  |  1996-11-18  |  15.1 KB  |  558 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)phasevdbob.tcl    /main/hindenburg/12
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)phasevdbob.tcl    /main/hindenburg/12   18 Nov 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. require "versionobj.tcl"
  16.  
  17. Class PhaseVDbObj : {BrowsDbObj VersionObj PhaseVersion} {
  18.     method destructor
  19.     constructor
  20.     method promoter
  21.     method addDocumentVersion
  22.     method addSystemVersion
  23.     method allowsDrop
  24.     method browserType
  25.     method changeLinks
  26.     method compareWithPrevPhase
  27.     method copy
  28.     method copyVersion
  29.     method deselectObjects
  30.     method importFromPrevPhase
  31.     method importObject
  32.     method initializeInfo
  33.     method linkStatus
  34.     method name
  35.     method newObjects
  36.     method phase
  37.     method prevPhaseExists
  38.     method removeObjects
  39.     method removeVersion
  40.     method selectObject
  41.     method systemVersions
  42.     attribute prevPhaseV
  43. }
  44.  
  45. method PhaseVDbObj::destructor {this} {
  46.     # Start destructor user section
  47.  
  48.     [$this customFileVersionSet] delete
  49.     [$this controlledListSet] delete
  50.  
  51.     # End destructor user section
  52.     $this BrowsDbObj::destructor
  53.     $this VersionObj::destructor
  54. }
  55.  
  56. constructor PhaseVDbObj {class this name} {
  57.     set this [PhaseVersion::constructor $class $this $name]
  58.     set this [BrowsDbObj::constructor $class $this $name]
  59.     set this [VersionObj::constructor $class $this $name]
  60.     return $this
  61. }
  62.  
  63. selfPromoter PhaseVersion {this} {
  64.     PhaseVDbObj promote $this
  65. }
  66.  
  67. method PhaseVDbObj::promoter {this} {
  68.     $this BrowsDbObj::promoter
  69.  
  70.     set customFileVersionSet $this.${CustFVUiObj::uiClass}:0
  71.     if {! [isCommand $customFileVersionSet]} {
  72.     CustFVUiObj new $customFileVersionSet -parent $this
  73.     }
  74.     $this customFileVersionSet $customFileVersionSet
  75.     set controlledListSet $this.${CListUiObj::uiClass}:0
  76.     if {! [isCommand $controlledListSet]} {
  77.     CListUiObj new $controlledListSet -parent $this
  78.     }
  79.     $this controlledListSet $controlledListSet
  80. }
  81.  
  82. method PhaseVDbObj::addDocumentVersion {this} {
  83.     require "newdocvdlg.tcl"
  84.     set box $wmttoolObj.newDocumentV
  85.     if {! [isCommand $box]} {
  86.     NewDocVDlg new $box
  87.     }
  88.     $box dbObj $this
  89.     $box popUp
  90. }
  91.  
  92. method PhaseVDbObj::addSystemVersion {this} {
  93.     require "newobjentr.tcl"
  94.  
  95.     if {! [isCommand $wmttoolObj.newSystemV]} {
  96.     NewObjEntryDlg new $wmttoolObj.newSystemV \
  97.         -title "New System Version" \
  98.         -message "System Name:" \
  99.         -okPressed {
  100.         set sysName [%this entry]
  101.         set sysType [lindex ${BrowserProcs::systemTypes} 0]
  102.         set configV [[%this dbObj] getParent ConfigVersion]
  103.         set script "[%this dbObj] createSystemVersion \
  104.                 [list $sysName] cl [list $sysType] $configV"
  105.         $wmttoolObj startCommand tcl \
  106.             "$script" "" \
  107.             "Creating $sysType version '$sysName'..." \
  108.             {1 0} 1
  109.         }
  110.     }
  111.     $wmttoolObj.newSystemV dbObj $this
  112.     $wmttoolObj.newSystemV popUp
  113. }
  114.  
  115. method PhaseVDbObj::allowsDrop {this uiClass} {
  116.     if {"$uiClass" != "SystemVersion"} {
  117.     return 0
  118.     }
  119.     return 1
  120. }
  121.  
  122. proc PhaseVDbObj::associations {} {
  123.     return {systemVersions customFileVersionSet controlledListSet accessRuleSet}
  124. }
  125.  
  126. method PhaseVDbObj::browserType {this} {
  127.     return [[$this phase] type]
  128. }
  129.  
  130. method PhaseVDbObj::changeLinks {this} {
  131.     ClassMaker::extend TemplateDialog ChangeLinksTemplateDialog dbObj
  132.     ChangeLinksTemplateDialog new $wmttoolObj.changeLink \
  133.     -modal yes \
  134.     -title "Change Link Status" \
  135.     -dbObj $this \
  136.     -helpPressed {.main helpOnName changeLink} \
  137.     -cancelPressed {%this delete} \
  138.     -okPressed {
  139.         set status [%this.top.status selected]
  140.         set script ""
  141.         foreach obj [$wmttoolObj selectedObjSet] {
  142.         set found 0
  143.         foreach link [$obj phaseVersionLinks] {
  144.             if {"[$link phaseVersion]" == "[%this dbObj]"} {
  145.             set found 1
  146.             break
  147.             }
  148.         }
  149.         if {! $found} {
  150.             wmtkerror "link to [$obj getInfo Type] \
  151.                 '[$obj getInfo Name]' not found"
  152.             continue
  153.         }
  154.         if {"$script" != ""} {
  155.             append script " ;"
  156.         }
  157.         append script " $link status $status"
  158.         }
  159.         if {"$script" != ""} {
  160.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  161.         }
  162.         %this delete
  163.     }
  164.     interface DlgColumn $wmttoolObj.changeLink.top {
  165.     Label messageLab {
  166.         text "Link Status:"
  167.     }
  168.     VerRadioGroup status {
  169.         entrySet {fixed dynamicFrozen}
  170.     }
  171.     }
  172.     if {[llength [$wmttoolObj selectedObjSet]] == 1} {
  173.     $wmttoolObj.changeLink.top.status selected \
  174.         [[lindex [$wmttoolObj selectedObjSet] 0] getInfo Link]
  175.     } else {
  176.     $wmttoolObj.changeLink.top.status selected fixed
  177.     }
  178.     $wmttoolObj.changeLink popUp
  179. }
  180.  
  181. proc PhaseVDbObj::childTypes {assoc} {
  182.     if {[lsearch -exact "[PhaseVDbObj::associations]" "$assoc"] == -1} {
  183.     return ""
  184.     }
  185.     set childTypes [BrowserProcs::childTypes $assoc]
  186.     if {"$childTypes" == "SystemVersion"} {
  187.     set childTypes ""
  188.     foreach systemType ${BrowserProcs::systemTypes} {
  189.         set firstChar [string toupper [string range $systemType 0 0]]
  190.         set type "${firstChar}[string range $systemType 1 end]"
  191.         lappend childTypes [format "%sVersion" $type]
  192.     }
  193.     }
  194.     return $childTypes
  195. }
  196.  
  197. method PhaseVDbObj::compareWithPrevPhase {this} {
  198.     require "comparepha.tcl"
  199.     ComparePhaseDlg new $wmttoolObj.compareWithPrevPhase \
  200.     -dbObj $this \
  201.     -title "Compare With Previous Phase" \
  202.     -helpPressed {.main helpOnName compareWithPrevPhase}
  203.     $wmttoolObj.compareWithPrevPhase popUp
  204. }
  205.  
  206. proc PhaseVDbObj::controlledLists {} {
  207.     return {
  208.     "[[$this phase] customFileList]"
  209.     "[$this customFileVersionLinkList]"
  210.     "[[$this phase] phaseVersionList]"
  211.     "[[$this phase] systemList]"
  212.     "[$this systemVersionLinkList]"
  213.     }
  214. }
  215.  
  216. method PhaseVDbObj::copy {this args} {
  217.  
  218.     set argc [llength $args]
  219.     set flag [lindex $args 0]
  220.     case "$flag" in {
  221.     {-systemVersion} {
  222.         if {$argc <= 3} {
  223.         eval $this PhaseVersion::copy $args
  224.         break
  225.         }
  226.         set sysV [lindex $args 1]
  227.         set editPasteCmdBusy [lindex $args [expr $argc -1]]
  228.  
  229.         set sys [$sysV system]
  230.         set sysName [$sys name]
  231.         set sysType [$sys type]
  232.         set oldSysV [$this findSystemVersion $sysName $sysType]
  233.         if {! [$oldSysV isNil]} {
  234.         $this deselectVersion $oldSysV
  235.         if $editPasteCmdBusy {
  236.             [.main undoCommand] addDeselected $oldSysV
  237.         }
  238.         }
  239.         set newSysV [eval \
  240.         $this PhaseVersion::copy [lrange $args 0 [expr $argc -3]]]
  241.         if {$editPasteCmdBusy && (! [$newSysV isNil])} {
  242.         [.main undoCommand] addObject $newSysV
  243.         }
  244.     }
  245.     {default} {
  246.         eval $this PhaseVersion::copy $args
  247.     }
  248.     }
  249. }
  250.  
  251. method PhaseVDbObj::copyVersion {this} {
  252.     set versionList ""
  253.     set myName [$this name]
  254.     foreach version [[$this phase] phaseVersions] {
  255.     if {"$version" == "$this"} continue
  256.     lappend versionList [list $version "$myName"]
  257.     }
  258.     BrowserProcs::copyVersion $this $versionList
  259. }
  260.  
  261. method PhaseVDbObj::deselectObjects {this} {
  262.     set script ""
  263.     foreach obj [$wmttoolObj selectedObjSet] {
  264.     if {"$script" != ""} {
  265.         append script " ;"
  266.     }
  267.     append script " $this deselectVersion $obj"
  268.     }
  269.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  270. }
  271.  
  272. method PhaseVDbObj::importFromPrevPhase {this mode} {
  273.     foreach sysV [$this getChildSet systemVersions] {
  274.     set sys [$sysV system]
  275.     if {"[$sys type]" != "system"} continue
  276.     set currentList([$sys name]) 1
  277.     }
  278.     set prevSysList ""
  279.     foreach sysV [[$this prevPhaseV] systemVersions] {
  280.     set sys [$sysV system]
  281.     if {"[$sys type]" != "system"} continue
  282.     if [info exists currentList([$sys name])] continue
  283.     lappend prevSysList $sys
  284.     }
  285.  
  286.     if [lempty $prevSysList] {
  287.     wmtkinfo "There are no new systems in the previous Phase Version"
  288.     return
  289.     }
  290.  
  291.     case "$mode" in {
  292.     {specific} {
  293.         set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  294.         SystemVersion SystemVersion \
  295.         ]
  296.         if {"$typeSpec" != ""} {
  297.         set icon [$typeSpec smallIcon]
  298.         } else {
  299.         set icon ""
  300.         }
  301.         set headerSpecList {{Name 25 ascii {increasing 1}}}
  302.         set objectSpecList ""
  303.         foreach sys $prevSysList {
  304.         lappend objectSpecList [list $icon [$sys name]]
  305.         }
  306.  
  307.         require "browsviewd.tcl"
  308.         set box $wmttoolObj.importSystems
  309.         ClassMaker::extend BrowsViewDialog ImpSysBrowsViewDialog dbObj
  310.         ImpSysBrowsViewDialog new $box \
  311.         -title "Import Systems" \
  312.         -headerSpecList $headerSpecList \
  313.         -objectSpecList $objectSpecList \
  314.         -objectList $prevSysList \
  315.         -dbObj $this \
  316.         -cancelPressed {%this delete} \
  317.         -okPressed {
  318.             set importSysList ""
  319.             foreach object [[%this view] selectedSet] {
  320.             lappend importSysList "[[$object object] identity]"
  321.             }
  322.             BrowserProcs::importSystems $importSysList
  323.             %this delete
  324.         }
  325.         $box popUp
  326.     }
  327.     {new} {
  328.         BrowserProcs::importSystems ""
  329.     }
  330.     }
  331. }
  332.  
  333. method PhaseVDbObj::importObject {this context node} {
  334.     set phaseVId [lindex $context 2]
  335.     if {$phaseVId == [$this getInfo Identity]} {
  336.     wmtkmessage "Can not import object into its own parent"
  337.     if [isCommand [.main undoCommand]] {
  338.         [.main undoCommand] delete
  339.     }
  340.     return
  341.     }
  342.  
  343.     set phaseV [BrowserProcs::id2obj $phaseVId PhaseVersion $node]
  344.     set dstType [$this getInfo Type]
  345.     set srcType [$phaseV getInfo Type]
  346.     if {"$srcType" != "$dstType" &&
  347.     ("$srcType" == "Implementation" || "$dstType" == "Implementation")} {
  348.     wmtkmessage "Can not import from '$srcType' to '$dstType'"
  349.     if [isCommand [.main undoCommand]] {
  350.         [.main undoCommand] delete
  351.     }
  352.     return
  353.     }
  354.  
  355.     # Make sure SystemVersion exists
  356.     set sysVId [lindex $context 3]
  357.     if {[catch {set sysV [BrowserProcs::id2obj $sysVId SystemVersion $node]}] ||
  358.     [catch {$sysV system}]} {
  359.     wmtkinfo "Can not import [lindex $context 4] because it is removed"
  360.     if [isCommand [.main undoCommand]] {
  361.         [.main undoCommand] delete
  362.     }
  363.     return
  364.     }
  365.  
  366.     set myConfV [$node getParent ConfigVersion]
  367.     set editPasteCmdBusy [.main undoCommandBusy EditPasteCmd]
  368.  
  369.     if {"$srcType" == "Implementation"} {
  370.     # The ClientContext must be set to the source
  371.     # system in order to determine the file's path
  372.     set clientContext [ClientContext::global]
  373.     set currentSysV [$clientContext currentSystem]
  374.     if {([llength $context] >= 6) && ([$currentSysV isNil] ||
  375.         [$currentSysV getInfo Identity] != $sysVId)} {
  376.         set levelIds [$clientContext currentLevelIdString]
  377.         while {! [[$clientContext currentProject] isNil]} {
  378.         $clientContext upLevel
  379.         }
  380.         $clientContext downLevelId \
  381.         [BrowserProcs::id2obj [lindex $context 0] Project $node]
  382.         $clientContext downLevelId \
  383.         [BrowserProcs::id2obj [lindex $context 1] ConfigVersion $node]
  384.         $clientContext downLevelId $phaseV
  385.         $clientContext downLevelId $sysV
  386.     } else {
  387.         set levelIds ""
  388.     }
  389.     }
  390.  
  391.     # Remove imported object in case of a cut operation
  392.     if {[.main undoCommandBusy EditPasteCmd] &&
  393.     "[[.main undoCommand] operation]" == "cut"} {
  394.     $phaseV cutVersion $sysV
  395.     }
  396.  
  397.     set script \
  398.     "$this copy -systemVersion $sysV $myConfV $node $editPasteCmdBusy"
  399.     if {$this == [[.main currentObj] browsUiObj]} {
  400.     set update 1
  401.     } else {
  402.     set update 0
  403.     }
  404.     $wmttoolObj startCommand tcl \
  405.     "$script" "" \
  406.     "Copying [$sysV getInfo Text]" \
  407.     [list $update 0] 1
  408.  
  409.     if {"$srcType" == "Implementation" && "$levelIds" != ""} {
  410.     $clientContext setLevelIds $levelIds
  411.     }
  412. }
  413.  
  414. proc PhaseVDbObj::infoProperties {} {
  415.     return [concat \
  416.     [BrowserProcs::infoProperties] \
  417.     {Status Link Version Comments Created Updated Frozen \
  418.      "Controlled Actions" "Created By"} \
  419.     ]
  420. }
  421.  
  422. method PhaseVDbObj::initializeInfo {this dummy} {
  423.     set oldLink [[$this info] set ConfigPhaseLink]
  424.     [$this info] contents ""
  425.     $this setInfo ConfigPhaseLink $oldLink
  426. }
  427.  
  428. method PhaseVDbObj::linkStatus {this} {
  429.     return [[[$this info] set ConfigPhaseLink] status]
  430. }
  431.  
  432. method PhaseVDbObj::name {this} {
  433.     return "[[$this phase] name]"
  434. }
  435.  
  436. method PhaseVDbObj::newObjects {this} {
  437.     set script ""
  438.     set confV [$this getParent ConfigVersion]
  439.     foreach obj [$wmttoolObj selectedObjSet] {
  440.     if {"$script" != ""} {
  441.         append script " ;"
  442.     }
  443.     append script " $this derive -systemVersion $obj $confV"
  444.     }
  445.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  446. }
  447.  
  448. method PhaseVDbObj::phase {this} {
  449.     if {[catch {set phase [[[$this info] set ConfigPhaseLink] phase]}] ||
  450.     [$phase isNil]} {
  451.     global errorInfo
  452.     set errorInfo ""
  453.     global errorCode
  454.     set errorCode ""
  455.     return [$this PhaseVersion::phase]
  456.     }
  457.     return $phase
  458. }
  459.  
  460. method PhaseVDbObj::prevPhaseExists {this} {
  461.     set confV [$this getParent ConfigVersion]
  462.     set prevPhaseV [$this previous $confV]
  463.     if {! [$prevPhaseV isA PhaseVersion]} {
  464.     return 0
  465.     }
  466.  
  467.     $this prevPhaseV $prevPhaseV
  468.     return 1
  469. }
  470.  
  471. method PhaseVDbObj::removeObjects {this} {
  472.     set box $wmttoolObj.removeWarning
  473.     ClassMaker::extend WarningDialog RemoveObjectsWarningDialog dbObj
  474.     RemoveObjectsWarningDialog new $box \
  475.     -title "Delete Warning" \
  476.     -message [BrowserProcs::removeMessage] \
  477.     -dbObj $this \
  478.     -helpPressed {.main helpOnName removeWarning} \
  479.     -cancelPressed {%this delete} \
  480.     -okPressed {
  481.         set dbObj [%this dbObj]
  482.         set script ""
  483.         foreach obj [$wmttoolObj selectedObjSet] {
  484.         if {"$script" != ""} {
  485.             append script " ;"
  486.         }
  487.         if [$obj isA DSysVDbObj] {
  488.             append script " $obj removeDocDir"
  489.             append script " ;"
  490.         }
  491.         append script " $dbObj removeObject $obj"
  492.         }
  493.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  494.         %this delete
  495.     }
  496.     $box popUp
  497. }
  498.  
  499. method PhaseVDbObj::removeVersion {this} {
  500.     set versionList ""
  501.     foreach version [[$this phase] phaseVersions] {
  502.     if [$version isLeaf] {
  503.         lappend versionList $version
  504.     }
  505.     }
  506.     BrowserProcs::removeVersion \
  507.     "[$this getParent ConfigVersion]" "[$this phase]" "$versionList"
  508. }
  509.  
  510. method PhaseVDbObj::selectObject {this mode} {
  511.     set versionList ""
  512.     foreach sysV [$this systemVersions] {
  513.     set workingList([$sysV system]) $sysV
  514.     }
  515.     case "$mode" in {
  516.     {new} {
  517.         set sysList ""
  518.         foreach sys [[$this phase] systems] {
  519.         if [info exists workingList($sys)] continue
  520.         lappend sysList $sys
  521.         }
  522.     }
  523.     {default} {
  524.         set sysList ""
  525.         foreach obj [$wmttoolObj selectedObjSet] {
  526.         lappend sysList [$obj system]
  527.         }
  528.     }
  529.     }
  530.     foreach sys $sysList {
  531.     set sysName [$sys name]
  532.     if [info exists workingList($sys)] {
  533.         set working $workingList($sys)
  534.     } else {
  535.         set working [ORB::nil]
  536.     }
  537.     foreach version [$sys systemVersions] {
  538.         if [$version isSame $working] continue
  539.         if {"[$version status]" == "working"} continue
  540.         lappend versionList [list $version "$sysName"]
  541.     }
  542.     }
  543.     BrowserProcs::selectObject $this $versionList $mode
  544. }
  545.  
  546. method PhaseVDbObj::systemVersions {this} {
  547.     set systemVersions ""
  548.     foreach link [$this systemVersionLinks] {
  549.     set sysV [$link systemVersion]
  550.     $sysV setInfo PhaseSystemLink $link
  551.     lappend systemVersions $sysV
  552.     }
  553.     return $systemVersions
  554. }
  555.  
  556. # Do not delete this line -- regeneration end marker
  557.  
  558.