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