home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / browserpro.tcl < prev    next >
Text File  |  1997-11-26  |  37KB  |  1,381 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)browserpro.tcl    /main/titanic/50
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)browserpro.tcl    /main/titanic/50   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.  
  15. Class BrowserProcs : {Object} {
  16.     constructor
  17.     method destructor
  18. }
  19.  
  20. global BrowserProcs::externalFileTypes
  21. set BrowserProcs::externalFileTypes ""
  22.  
  23. global BrowserProcs::diagramFileTypes
  24. set BrowserProcs::diagramFileTypes ""
  25.  
  26. global BrowserProcs::programmerFileTypes
  27. set BrowserProcs::programmerFileTypes ""
  28.  
  29. global BrowserProcs::itemTypes
  30. set BrowserProcs::itemTypes "cl de doc et pe st"
  31.  
  32. global BrowserProcs::phases
  33. set BrowserProcs::phases ""
  34.  
  35. global BrowserProcs::systemTypes
  36. set BrowserProcs::systemTypes "system"
  37.  
  38. global BrowserProcs::infoProperties
  39. set BrowserProcs::infoProperties "Name Type Identity Text"
  40.  
  41.  
  42. constructor BrowserProcs {class this name} {
  43.     set this [Object::constructor $class $this $name]
  44.     # Start constructor user section
  45.     # End constructor user section
  46.     return $this
  47. }
  48.  
  49. method BrowserProcs::destructor {this} {
  50.     # Start destructor user section
  51.     # End destructor user section
  52. }
  53.  
  54. proc BrowserProcs::action2String {map} {
  55.     BrowserProcs::initializeActionTable
  56.  
  57.     set actions ""
  58.     for {set actionMap 1} \
  59.     {$actionMap <= 512} \
  60.     {set actionMap [expr $actionMap << 1]} {
  61.     if {$map & $actionMap} {
  62.         lappend actions $actionTable($actionMap)
  63.     }
  64.     }
  65.     return "$actions"
  66. }
  67.  
  68. proc BrowserProcs::changeName {} {
  69.     set selectedObject [lindex [$wmttoolObj selectedObjSet] 0]
  70.  
  71.     # get item and keeper for objects that have one
  72.     if [$selectedObject isA SystemVersion] {
  73.     set item [[$selectedObject system] item]
  74.     set keeper $selectedObject
  75.     } elseif [$selectedObject isA FileVersion] {
  76.     set item [[$selectedObject file] item]
  77.     set keeper [$selectedObject getParent SystemVersion]
  78.     } elseif [$selectedObject isA WorkItem] {
  79.     set item [$selectedObject item]
  80.     set keeper [$selectedObject owner]
  81.     } elseif {[$selectedObject isA ExternalLink] ||
  82.           [$selectedObject isA ConfigVersion] ||
  83.           [$selectedObject isA Project] ||
  84.           [$selectedObject isA Model]} {
  85.     set item ""
  86.     set keeper ""
  87.     } else {
  88.     wmtkerror "Cannot change the name of the selected object"
  89.     return
  90.     }
  91.  
  92.     # determine configVersion of objects with an item
  93.     if { "$item" != "" } {
  94.     set configV [$selectedObject getParent ConfigVersion]
  95.     } else {
  96.     set configV ""
  97.     }
  98.  
  99.     require "objnamecha.tcl"
  100.     ObjNameChangeDialog new $wmttoolObj.changeName $wmttoolObj \
  101.     -configV $configV \
  102.     -keeper $keeper \
  103.     -item $item
  104.     $wmttoolObj.changeName popUp
  105. }
  106.  
  107.  
  108. # Pops up a scope change dialog for the
  109. # given object (a cdm).
  110. #
  111. proc BrowserProcs::changeScope {object} {
  112.     if { ![isCommand .main.scopechange] } {
  113.     require "cdmscopech.tcl"
  114.     CdmScopeChangeDialog new .main.scopechange
  115.     }
  116.  
  117.     set systemVersion [$object getParent SystemVersion]
  118.     set configVersion [$object getParent ConfigVersion]
  119.  
  120.     set item [[$object file] item]
  121.     set workItem [$systemVersion findDeclaration $item $configVersion]
  122.  
  123.     .main.scopechange config \
  124.         -configV $configVersion \
  125.         -systemV $systemVersion \
  126.         -item $item \
  127.         -workItem $workItem
  128.  
  129.     .main.scopechange popUp
  130. }
  131.  
  132. proc BrowserProcs::childTypes {assoc} {
  133.     case "$assoc" in {
  134.     {controlledClasses} {
  135.         return "ControlledClass"
  136.     }
  137.     {controlledClassSet} {
  138.         return "ControlledClasses"
  139.     }
  140.     {accessRuleSet} {
  141.         return "AccessRules"
  142.     }
  143.     {rules} {
  144.         return "AccessRule"
  145.     }
  146.     {savedGroupVersion} {
  147.         return "SavedGroupVersion"
  148.     }
  149.     {roleLinks userLinks} {
  150.         return "UserRoleLink"
  151.     }
  152.     {default} {
  153.         if [regsub "Set" "$assoc" "s" assoc] {
  154.         return "[string toupper [string range $assoc 0 0]][string \
  155.             range $assoc 1 end]"
  156.         }
  157.         return "[string toupper [string range $assoc 0 0]][string \
  158.         range $assoc 1 [expr [string length $assoc] - 2]]"
  159.     }
  160.     }
  161. }
  162.  
  163. proc BrowserProcs::clone {} {
  164.     set context ""
  165.     if [BrowserProcs::currentObjIsA BrowsUiObj] {
  166.     set browsUiObj [[$wmttoolObj currentObj] browsUiObj]
  167.     while {"$browsUiObj" != ""} {
  168.         set context "[$browsUiObj getInfo Identity] $context"
  169.         set browsUiObj [$browsUiObj parent]
  170.     }
  171.     }
  172.     # check the current view before cloning
  173.     [[.main infoView] fastViewHandler] checkView [.main infoView]
  174.     # save the view stuff
  175.     [[.main infoView] fastViewHandler] saveObjects
  176.     $wmttoolObj startCommand tcl \
  177.     "SystemUtilities::fork otk desk -c [list [get_comm_name]] $context" \
  178.     "" "Starting browser" {0 0} 1
  179. }
  180.  
  181. proc BrowserProcs::compareVersion {obj orig versionList} {
  182.     if [lempty $versionList] {
  183.     wmtkinfo "There are no other versions to compare with"
  184.     return
  185.     }
  186.  
  187.     set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  188.     [$obj uiClass] [$obj browserType] \
  189.     ]
  190.     if {"$typeSpec" != ""} {
  191.     set icon [$typeSpec smallIcon]
  192.     } else {
  193.     set icon ""
  194.     }
  195.     set headerSpecList {
  196.     {Version 25 ascii {increasing 1}}
  197.     {Status 14 ascii {increasing 2}}
  198.     {"Frozen date" 30 ascii {none}}
  199.     {Comments 50 ascii {none}}
  200.     }
  201.     set objectSpecList ""
  202.     foreach version $versionList {
  203.     lappend objectSpecList [list $icon \
  204.         [$version versionName] \
  205.         [$version status] \
  206.         [$version freezeTime2String] \
  207.         [$version comments] \
  208.     ]
  209.     }
  210.  
  211.     require "browsviewd.tcl"
  212.     set box $wmttoolObj.compareVersion
  213.     ClassMaker::extend BrowsViewDialog CompareVBrowsViewDialog dbObj
  214.     CompareVBrowsViewDialog new $box \
  215.     -title "Compare Version" \
  216.     -message "[$orig text]" \
  217.     -headerSpecList $headerSpecList \
  218.     -objectSpecList $objectSpecList \
  219.     -objectList $versionList \
  220.     -dbObj $obj \
  221.     -cancelPressed {%this delete} \
  222.     -okPressed {
  223.         set dbObj [%this dbObj]
  224.         set version [[lindex [[%this view] selectedSet] 0] object]
  225.  
  226.         if {[$dbObj isA Graph] || [$dbObj isA Matrix]} {
  227.         set script "[quoteIf [m4_path_name bin udmcmp$EXE_EXT]] \
  228.             [$dbObj identity] [$version identity]"
  229.         set endScript ""
  230.         set message "Starting 'Compare version'"
  231.         } elseif [$obj isA ExternalFileVersion] {
  232.         $obj synchWithFileSystem
  233.         set tmpFile [args_file {}]
  234.         case "[$version status]" in {
  235.             {backGround} {
  236.             $version activate
  237.             $version downLoadFrozenContents $tmpFile
  238.             $version deactivate
  239.             }
  240.             {frozen reused} {
  241.             $version downLoadFrozenContents $tmpFile
  242.             }
  243.             {default} {
  244.             copy_text_file \
  245.                 [$version path [$version currentContext]] $tmpFile
  246.             }
  247.         }
  248.         set script "[m4_var get M4_diff] [$obj path] $tmpFile"
  249.         set endScript [list BasicFS::removeFile $tmpFile]
  250.         set message "Starting 'Compare'"
  251.         } elseif [$dbObj isA RemoteFile] {
  252.         set tmpFile1 [args_file {}]
  253.         $dbObj downLoad $tmpFile1
  254.         set tmpFile2 [args_file {}]
  255.         case "[$version status]" in {
  256.             {backGround} {
  257.             $version activate
  258.             $version downLoad $tmpFile2
  259.             $version deactivate
  260.             }
  261.             {default} {
  262.             $version downLoad $tmpFile2
  263.             }
  264.         }
  265.         set script "[m4_var get M4_diff] $tmpFile1 $tmpFile2"
  266.         set endScript ""
  267.         append endScript [list BasicFS::removeFile $tmpFile1]
  268.         append endScript " ;"
  269.         append endScript [list BasicFS::removeFile $tmpFile2]
  270.         set message "Starting 'Compare'"
  271.         } else {
  272.         wmtkerror "Sorry, don't know how to compare [$dbObj objType]"
  273.         }
  274.         $wmttoolObj startCommand mtool \
  275.         "$script" "$endScript" "$message" {0 0} 0
  276.         %this delete
  277.     }
  278.     [$box view] selectionPolicy BROWSE
  279.     $box popUp
  280. }
  281.  
  282. proc BrowserProcs::copyUserEnv {level} {
  283.     if {"$level" == "Corporate"} {
  284.     set levelObj [$wmttoolObj corporateObj]
  285.     } else {
  286.     set levelObj [[$wmttoolObj currentObj] browsUiObj]
  287.     if {! [$levelObj isA $level]} {
  288.         set levelObj [$levelObj getParent $level]
  289.     }
  290.     }
  291.     require "copyenvdia.tcl"
  292.     CopyEnvDialog new $wmttoolObj.copyUserEnv 2 $levelObj \
  293.     -title "Copy User Env To $level" \
  294.     -m4VarDes [$wmttoolObj m4VarDes] \
  295.     -helpPressed {.main helpOnName copyUserEnv} \
  296.     -cancelPressed {%this delete} \
  297.     -okPressed {
  298.         %this save
  299.         %this delete
  300.     }
  301.     $wmttoolObj.copyUserEnv popUp
  302. }
  303.  
  304. proc BrowserProcs::copyVersion {obj versionList} {
  305.     if [lempty $versionList] {
  306.     wmtkinfo "There are no other versions to copy from"
  307.     return
  308.     }
  309.  
  310.     set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  311.     [$obj uiClass] [$obj browserType] \
  312.     ]
  313.     if {"$typeSpec" != ""} {
  314.     set icon [$typeSpec smallIcon]
  315.     } else {
  316.     set icon ""
  317.     }
  318.     set headerSpecList {
  319.     {Name 25 ascii {increasing 1}}
  320.     {Version 25 ascii {increasing 2}}
  321.     {Status 14 ascii {increasing 3}}
  322.     {"Frozen date" 30 ascii {none}}
  323.     {Comments 50 ascii {none}}
  324.     }
  325.     set objectSpecList ""
  326.     foreach tuple $versionList {
  327.     set version [lindex $tuple 0]
  328.     lappend objectSpecList [list $icon \
  329.         [lindex $tuple 1] \
  330.         [$version versionName] \
  331.         [$version status] \
  332.         [$version freezeTime2String] \
  333.         [$version comments] \
  334.     ]
  335.     }
  336.  
  337.     require "browsviewd.tcl"
  338.     set box $wmttoolObj.copyVersion
  339.     ClassMaker::extend BrowsViewDialog CopyVBrowsViewDialog dbObj
  340.     CopyVBrowsViewDialog new $box \
  341.     -title "Copy Version From" \
  342.     -headerSpecList $headerSpecList \
  343.     -objectSpecList $objectSpecList \
  344.     -objectList $versionList \
  345.     -dbObj $obj \
  346.     -cancelPressed {%this delete} \
  347.     -okPressed {
  348.         set dbObj [%this dbObj]
  349.         set version \
  350.         [lindex [[lindex [[%this view] selectedSet] 0] object] 0]
  351.         if [$dbObj isA ConfigVersion] {
  352.         set args "-configVersion $version"
  353.         } elseif [$dbObj isA PhaseVersion] {
  354.         set args "-phaseVersion $version"
  355.         } elseif [$dbObj isA SystemVersion] {
  356.         set confV [$dbObj getParent ConfigVersion]
  357.         set args "{} -systemVersion $version $confV"
  358.         } else {
  359.         set args "$version"
  360.         }
  361.         set script "$dbObj copy $args"
  362.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  363.         %this delete
  364.     }
  365.     [$box view] config \
  366.     -rowCount 10 \
  367.     -selectionPolicy BROWSE
  368.     $box popUp
  369. }
  370.  
  371. proc BrowserProcs::currentObjIsA {typeList} {
  372.     set currentObj [$wmttoolObj currentObj]
  373.     if {! [isCommand $currentObj]} {
  374.     return 0
  375.     }
  376.     foreach type $typeList {
  377.     if [[$currentObj browsUiObj] isA $type] {
  378.         return 1
  379.     }
  380.     }
  381.  
  382.     return 0
  383. }
  384.  
  385. proc BrowserProcs::currentUser {} {
  386.     set corporate [$wmttoolObj corporateObj]
  387.     return [$corporate currentUser]
  388. }
  389.  
  390. proc BrowserProcs::displayDate {date} {
  391.     if {$date <= 0} {
  392.     return ""
  393.     }
  394.     return "[clock format $date]"
  395. }
  396.  
  397. proc BrowserProcs::editProperties {} {
  398.     busy {
  399.     $wmttoolObj createPropContainers 1
  400.     # Don't reuse a PropertyDialog:
  401.     # The initial size does not change to fit new contents.
  402.     require "propertydi.tcl"
  403.     PropertyDialog new $wmttoolObj.editProperties $wmttoolObj \
  404.         -editable 1 \
  405.         -title "Edit Properties" \
  406.         -helpPressed {.main helpOnName editProperties}
  407.     $wmttoolObj.editProperties popUp
  408.     }
  409. }
  410.  
  411. proc BrowserProcs::effectiveRoles {} {
  412.     set securityLevel [[ClientContext::global] currentSecurityLevel]
  413.     if [$securityLevel isNil] {
  414.     set securityLevel [$wmttoolObj corporateObj]
  415.     }
  416.  
  417.     set effectiveRoleList ""
  418.     foreach role [$securityLevel effectiveRoles] {
  419.     set roleName "[$role name]"
  420.     lappend effectiveRoleList "$roleName"
  421.     }
  422.     return $effectiveRoleList
  423. }
  424.  
  425. proc BrowserProcs::freezeObjects {objectList} {
  426.     if {! [isCommand $wmttoolObj.freezeVersion]} {
  427.     ClassMaker::extend EntryDialog FreezeVEntryDialog objectList
  428.     FreezeVEntryDialog new $wmttoolObj.freezeVersion \
  429.         -modal yes \
  430.         -title "Freeze Version" \
  431.         -message "Comments:" \
  432.         -helpPressed {.main helpOnName freezeVersion} \
  433.         -okPressed {
  434.         BrowserProcs::freezeObjectsOk \
  435.             "[%this objectList]" "[%this entry]"
  436.         }
  437.     }
  438.     $wmttoolObj.freezeVersion objectList "$objectList"
  439.     $wmttoolObj.freezeVersion popUp
  440. }
  441.  
  442. proc BrowserProcs::freezeObjectsOk {objectList comments} {
  443.     set script ""
  444.     foreach obj $objectList {
  445.     if {"$script" != ""} {
  446.         append script " ;"
  447.     }
  448.     append script " $obj freeze [list $comments]"
  449.     }
  450.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  451. }
  452.  
  453. proc BrowserProcs::getParentObj {} {
  454.     set currentObj [[.main treeView] selected]
  455.     if {"$currentObj" != ""} {
  456.     return [[$currentObj browsUiObj] parent]
  457.     }
  458.     set currentObj [.main currentObj]
  459.     if {! [isCommand $currentObj]} {
  460.     return ""
  461.     }
  462.     return [$currentObj browsUiObj]
  463. }
  464.  
  465. proc BrowserProcs::graphTypes {} {
  466.     return "cad ccd cod etd std ucd"
  467. }
  468.  
  469. proc BrowserProcs::id2obj {id type node} {
  470.     # Search object in given tree node
  471.     set myObj [$node browsUiObj]
  472.     if {! [$myObj isA $type]} {
  473.     set myObj [$node getParent $type]
  474.     }
  475.     if {[isCommand $myObj] && ([$myObj getInfo Identity] == $id)} {
  476.     return $myObj
  477.     }
  478.  
  479.     # Search object in current tree node
  480.     set currentNode [.main currentObj]
  481.     if {$currentNode != $node} {
  482.     set currentObj [$currentNode browsUiObj]
  483.     if {! [$currentObj isA $type]} {
  484.         set currentObj [$currentNode getParent $type]
  485.     }
  486.     if {[isCommand $currentObj] &&
  487.         ([$currentObj getInfo Identity] == $id)} {
  488.         return $currentObj
  489.     }
  490.     }
  491.  
  492.     # Search in currrent view
  493.     foreach flatObj [[.main flatView] objectSet] {
  494.     if [$flatObj filteredOutState] continue
  495.     set childObj [$flatObj browsUiObj]
  496.     if {[isCommand $childObj] &&
  497.         ([$childObj getInfo Identity] == $id)} {
  498.         return $childObj
  499.     }
  500.     }
  501.  
  502.     return [$type new $id]
  503. }
  504.  
  505. proc BrowserProcs::importSystems {systemList} {
  506.     set args "-f impsystems.tcl"
  507.     if {! [lempty $systemList]} {
  508.        set args "$args -- $systemList"
  509.     }
  510.     set script "[quoteIf [m4_path_name bin otsh$EXE_EXT]] $args"
  511.     $wmttoolObj startCommand mtool \
  512.     "$script" "" "Starting 'Import Systems'" {1 0} 0
  513. }
  514.  
  515. proc BrowserProcs::infoProperties {} {
  516.     return ${BrowserProcs::infoProperties}
  517. }
  518.  
  519. proc BrowserProcs::initializeActionTable {} {
  520.     global actionTable
  521.  
  522.     if [info exists actionTable] {
  523.     return
  524.     }
  525.  
  526.     set actionTable(1) controlAction
  527.     set actionTable(2) createAction
  528.     set actionTable(4) destroyAction
  529.     set actionTable(8) readAction
  530.     set actionTable(16) modifyAction
  531.     set actionTable(32) insertAction
  532.     set actionTable(64) removeAction
  533.     set actionTable(128) freezeAction
  534.     set actionTable(256) unfreezeAction
  535.     set actionTable(512) modifyStatusAction
  536. }
  537.  
  538. proc BrowserProcs::initializeInfo {obj node} {
  539.     global initializeInfoDict initializeInfoDictSet
  540.  
  541.     if {! [info exists initializeInfoDict]} {
  542.     set initializeInfoDict [Dictionary new]
  543.     }
  544.     if {(! [info exists initializeInfoDictSet]) ||
  545.     (! $initializeInfoDictSet)} {
  546.     $initializeInfoDict set FilePropertyReference ConfigVersion
  547.     set initializeInfoDictSet 1
  548.     }
  549.     set parentClass [$initializeInfoDict set [$obj uiClass]]
  550.     if {"$parentClass" != ""} {
  551.     set parent $node
  552.     if [$parent isA TreeNode] {
  553.         set parent [$parent browsUiObj]
  554.     }
  555.     if {! [$parent isA $parentClass]} {
  556.         set parent [$node getParent $parentClass]
  557.     }
  558.     } else {
  559.     set parent ""
  560.     }
  561.     $obj initializeInfo "$parent"
  562. }
  563.  
  564. proc BrowserProcs::matrixTypes {{dsmToo 0}} {
  565.     set matrixTypes "cdm"
  566.     if $dsmToo {
  567.         lappend matrixTypes "dsm"
  568.     }
  569.     return $matrixTypes
  570. }
  571.  
  572. proc BrowserProcs::objectsAre {type} {
  573.     case "[$wmttoolObj getStatus $type]" in {
  574.     {yes} {
  575.         return 1
  576.     }
  577.     {no} {
  578.         return 0
  579.     }
  580.     {default} {
  581.         foreach obj [$wmttoolObj selectedObjSet] {
  582.         if {! [$obj isA $type]} {
  583.             $wmttoolObj setStatus $type no
  584.             return 0
  585.         }
  586.         }
  587.         $wmttoolObj setStatus $type yes
  588.         return 1
  589.     }
  590.     }
  591. }
  592.  
  593. proc BrowserProcs::objectsReturn {method} {
  594.     case "[$wmttoolObj getStatus $method]" in {
  595.     {yes} {
  596.         return 1
  597.     }
  598.     {no} {
  599.         return 0
  600.     }
  601.     {default} {
  602.         foreach obj [$wmttoolObj selectedObjSet] {
  603.         if {! [$obj $method]} {
  604.             $wmttoolObj setStatus $method no
  605.             return 0
  606.         }
  607.         }
  608.         $wmttoolObj setStatus $method yes
  609.         return 1
  610.     }
  611.     }
  612. }
  613.  
  614. proc BrowserProcs::parentObjIsA {typeList} {
  615.     set parentObj [BrowserProcs::getParentObj]
  616.     if {! [isCommand $parentObj]} {
  617.     return 0
  618.     }
  619.     foreach type $typeList {
  620.     if [$parentObj isA $type] {
  621.         return 1
  622.     }
  623.     }
  624.  
  625.     return 0
  626. }
  627.  
  628. proc BrowserProcs::printObjects {asciiFiles topostObjects {deleteFlag 0}} {
  629.     busy {
  630.     if {! [lempty $asciiFiles]} {
  631.     # Can not print more than 1 file at once on win95
  632.     if {$win95 && ([llength $asciiFiles] > 1)} {
  633.         foreach asciiFile $asciiFiles {
  634.         BrowserProcs::printObjects "[list $asciiFile]" "" $deleteFlag
  635.         }
  636.     } else {
  637.         set printer [m4_var get M4_a_printer]
  638.         set cmd $printer
  639.         set endCmd ""
  640.         foreach asciiFile $asciiFiles {
  641.         if $deleteFlag {
  642.             if {"$endCmd" != ""} {
  643.             append endCmd " ;"
  644.             }
  645.             append endCmd "[list BasicFS::removeFile $asciiFile]"
  646.         }
  647.         if $win95 {
  648.             append cmd " $asciiFile"
  649.         } else {
  650.             append cmd " \"$asciiFile\""
  651.         }
  652.         }
  653.         set msg "Sending "
  654.         if {[llength $asciiFiles] == 1} {
  655.         append msg "'[lindex $asciiFiles 0]'"
  656.         } else {
  657.         append msg "output"
  658.         }
  659.         append msg " to $printer..."
  660.         $wmttoolObj startCommand extern "$cmd" "$endCmd" "$msg" {0 0} 0
  661.     }
  662.     }
  663.     if {! [lempty $topostObjects]} {
  664.     set sysV [[$wmttoolObj currentObj] browsUiObj]
  665.     if {! [$sysV isA SystemVersion]} {
  666.         set sysV [$sysV getParent SystemVersion]
  667.     }
  668.     set confV [$sysV getParent ConfigVersion]
  669.     require "print.tcl"
  670.     eval Print::printDiagrams \
  671.         -configVersion $confV \
  672.         -systemVersion $sysV \
  673.         $topostObjects
  674.     }
  675.     }
  676. }
  677.  
  678. proc BrowserProcs::removeMessage {{dialog ""}} {
  679.     if {"$dialog" == ""} {
  680.     set objects [$wmttoolObj selectedNameSet]
  681.     set len [llength $objects]
  682.     if {$len == 1} {
  683.         set object [lindex $objects 0]
  684.         set description "[lindex $object 1] '[lindex $object 0]'"
  685.     }
  686.     } else {
  687.     set selectedSet [[$dialog view] selectedSet]
  688.     if [lempty $selectedSet] {
  689.         set selectedSet [[$dialog view] objectSet]
  690.     }
  691.     set len [llength $selectedSet]
  692.     if {$len == 1} {
  693.         set version [[lindex $selectedSet 0] object]
  694.         set description \
  695.         "version [$version versionName] of [[$dialog orig] text]"
  696.     }
  697.     }
  698.     if {$len > 1} {
  699.     set description "these $len objects"
  700.     } elseif [.main isA CommonBrowser] {
  701.     set selectedNode [[.main treeView] selected]
  702.     if {"$selectedNode" != ""} {
  703.         [.main infoView] removedObj $selectedNode
  704.     }
  705.     }
  706.     return "Are you sure you want to delete $description ?"
  707. }
  708.  
  709. proc BrowserProcs::removeProperties {} {
  710.     busy {
  711.     $wmttoolObj createPropContainers 1
  712.     # Don't reuse a RmPropDialog:
  713.     # The initial size does not change to fit new contents.
  714.     require "rmpropdial.tcl"
  715.     RmPropDialog new $wmttoolObj.removeProperties $wmttoolObj \
  716.         -title "Delete Properties" \
  717.         -helpPressed {.main helpOnName removeProperties}
  718.     $wmttoolObj.removeProperties popUp
  719.     }
  720. }
  721.  
  722. proc BrowserProcs::removeVersion {obj orig versionList {endScript ""}} {
  723.     set selectedObj [lindex [$wmttoolObj selectedObjSet] 0]
  724.     set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  725.     [$selectedObj uiClass] [$selectedObj browserType] \
  726.     ]
  727.     if {"$typeSpec" != ""} {
  728.     set icon [$typeSpec smallIcon]
  729.     } else {
  730.     set icon ""
  731.     }
  732.     set headerSpecList {
  733.     {Version 25 ascii {increasing 1}}
  734.     {Status 14 ascii {increasing 2}}
  735.     {"Frozen date" 30 ascii {none}}
  736.     {Comments 50 ascii {none}}
  737.     }
  738.     set objectSpecList ""
  739.     foreach version $versionList {
  740.     lappend objectSpecList [list $icon \
  741.         [$version versionName] \
  742.         [$version status] \
  743.         [$version freezeTime2String] \
  744.         [$version comments] \
  745.     ]
  746.     }
  747.  
  748.     require "browsviewd.tcl"
  749.     set box $wmttoolObj.removeVersion
  750.     ClassMaker::extend BrowsViewDialog RemoveVBrowsViewDialog {dbObj orig endScript}
  751.     ClassMaker::extend YesNoWarningDialog WarningDialogWithEndScript endScript
  752.     RemoveVBrowsViewDialog new $box \
  753.     -title "Delete Version" \
  754.     -message "[$orig text]" \
  755.     -headerSpecList $headerSpecList \
  756.     -objectSpecList $objectSpecList \
  757.     -objectList $versionList \
  758.     -dbObj $obj \
  759.     -orig $orig \
  760.     -cancelPressed {%this delete} \
  761.     -endScript "$endScript" \
  762.     -okPressed {
  763.         WarningDialogWithEndScript new [format "%s%s" %this Warning] \
  764.         -title "Confirm Version Delete" \
  765.         -message [BrowserProcs::removeMessage %this] \
  766.         -helpPressed {.main helpOnName removeVersionWarning} \
  767.         -noPressed {
  768.             %this delete
  769.            [format "%s%s" %this Warning] delete
  770.         } \
  771.         -yesPressed {
  772.             set dbObj [%this dbObj]
  773.             set orig [%this orig]
  774.             set objectSet [[%this view] objectSet]
  775.             set selectedSet [[%this view] selectedSet]
  776.             if [lempty $selectedSet] {
  777.             set selectedSet $objectSet
  778.             }
  779.             set script ""
  780.             foreach object $selectedSet {
  781.             if {"$script" != ""} {
  782.                 append script " ;"
  783.             }
  784.             append script " $dbObj removeObject [$object object]"
  785.             }
  786.             $wmttoolObj startCommand tcl "$script" [%this endScript] "" {1 0} 1
  787.             [format "%s%s" %this Warning] delete
  788.             %this delete
  789.         }
  790.         [format "%s%s" %this Warning] delCancelButton
  791.         [format "%s%s" %this Warning] endScript "[%this endScript]"
  792.         [format "%s%s" %this Warning] popUp
  793.     }
  794.     if {[$orig isA Config] ||
  795.     ([llength $versionList] == 1 &&
  796.      [lindex $versionList 0] == $selectedObj)} {
  797.     $box display
  798.     eval [$box okPressed]
  799.     } else {
  800.     $box popUp
  801.     }
  802. }
  803.  
  804. proc BrowserProcs::scopeObjectsAre {scope} {
  805.     case "[$wmttoolObj getStatus $scope]" in {
  806.     {yes} {
  807.         return 1
  808.     }
  809.     {no} {
  810.         return 0
  811.     }
  812.     {default} {
  813.         foreach obj [$wmttoolObj selectedObjSet] {
  814.         set objScope [$obj getInfo Scope]
  815.         if {"$objScope" == ""} continue
  816.         if {"$objScope" != "$scope"} {
  817.             $wmttoolObj setStatus "$scope" no
  818.             return 0
  819.         }
  820.         }
  821.         $wmttoolObj setStatus "$scope" yes
  822.         return 1
  823.     }
  824.     }
  825. }
  826.  
  827. proc BrowserProcs::selectObject {obj versionList mode} {
  828.     if [lempty $versionList] {
  829.     wmtkinfo "There are no other versions to select from"
  830.     return
  831.     }
  832.  
  833.     set headerSpecList ""
  834.     if {"$mode" != "selected"} {
  835.     lappend headerSpecList {Name 25 ascii {increasing 2}}
  836.         lappend headerSpecList {Version 25 ascii {increasing 3}}
  837.     lappend headerSpecList {Type 18 ascii {increasing 1}}
  838.     } else {
  839.         lappend headerSpecList {Version 25 ascii {increasing 1}}
  840.     }
  841.     lappend headerSpecList {"Frozen date" 30 ascii {none}}
  842.     lappend headerSpecList {Comments 50 ascii {none}}
  843.  
  844.     set objectSpecList ""
  845.     foreach tuple $versionList {
  846.     set version [lindex $tuple 0]
  847.     set typeSpec [getObjectSpec [$wmttoolObj objectHdlr] \
  848.         [$version uiClass] [$version browserType] \
  849.     ]
  850.     if {"$typeSpec" != ""} {
  851.         set icon [$typeSpec smallIcon]
  852.     } else {
  853.         set icon ""
  854.     }
  855.     set objectSpec "$icon"
  856.     if {"$mode" != "selected"} {
  857.         lappend objectSpec [lindex $tuple 1]
  858.         lappend objectSpec [$version versionName]
  859.         lappend objectSpec [$version browserType]
  860.     } else {
  861.         lappend objectSpec [$version versionName]
  862.     }
  863.     lappend objectSpec [$version freezeTime2String]
  864.     lappend objectSpec [$version comments]
  865.     lappend objectSpecList $objectSpec
  866.     }
  867.  
  868.     require "browsviewd.tcl"
  869.     set box $wmttoolObj.selectVersion
  870.     ClassMaker::extend BrowsViewDialog SelectVBrowsViewDialog dbObj
  871.     SelectVBrowsViewDialog new $box \
  872.     -title "Select Version" \
  873.     -headerSpecList $headerSpecList \
  874.     -objectSpecList $objectSpecList \
  875.     -objectList $versionList \
  876.     -dbObj $obj \
  877.     -cancelPressed {%this delete} \
  878.     -okPressed {
  879.         set dbObj "[%this dbObj]"
  880.         set script ""
  881.         foreach object [[%this view] selectedSet] {
  882.         if {"$script" != ""} {
  883.             append script " ;"
  884.         }
  885.         append script \
  886.             " $dbObj selectVersion [lindex [$object object] 0]"
  887.         }
  888.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  889.         %this delete
  890.     }
  891.     if {"$mode" == "selected"} {
  892.     set selectionPolicy BROWSE
  893.     } else {
  894.     set selectionPolicy EXTENDED
  895.     }
  896.     [$box view] config \
  897.     -rowCount 10 \
  898.     -selectionPolicy $selectionPolicy
  899.     $box popUp
  900. }
  901.  
  902. proc BrowserProcs::showInfo {{skip 0}} {
  903.     set objList [$wmttoolObj selectedObjSet]
  904.     if [lempty $objList] {
  905.     return
  906.     }
  907.  
  908.     global classCount
  909.     incr classCount
  910.     set box $wmttoolObj.info$classCount
  911.     interface TemplateDialog $box {
  912.     title "Info"
  913.     DlgColumn col { }
  914.     helpPressed { .main helpOnName info }
  915.     okPressed { %this delete }
  916.     }
  917.     $box modal $win95
  918.     $box delCancelButton
  919.  
  920.     set lineCnt 0
  921.     set sepCnt 0
  922.     foreach obj $objList {
  923.     if { $sepCnt != 0 } {
  924.         HorSeparator new $box.col.$sepCnt
  925.     }
  926.     incr sepCnt
  927.     foreach header [[$obj browserObjType]::infoProperties] {
  928.             set info [$obj getInfo $header]
  929.         if $skip {
  930.         if {$info == " "} continue
  931.         }
  932.         DlgRow new $box.col.row$lineCnt \
  933.                 -spaceType NONE -justification RIGHT
  934.         Label new $box.col.row$lineCnt.$lineCnt -text "$header:" \
  935.         -alignment RIGHT -horStretchFactor 10 \
  936.         -justification TOP -font "courier-bold-12"
  937.         DlgColumn new $box.col.row$lineCnt.col
  938.         set breakUpCnt 0
  939.             if { $info == "" } {
  940.                 set info " "
  941.             }
  942.             foreach line [split $info "\n"] {
  943.                 foreach part [lineBreak $line 49 " "] {
  944.                     set text [format "%-49s" $part]
  945.                     Label new $box.col.row$lineCnt.col.${lineCnt}_$breakUpCnt \
  946.                             -text $text -font "courier-normal-12"
  947.                     incr breakUpCnt
  948.                 }
  949.             }
  950.             incr lineCnt
  951.     }
  952.     }
  953.  
  954.     $box popUp
  955. }
  956.  
  957. proc BrowserProcs::showProperties {} {
  958.     busy {
  959.     $wmttoolObj createPropContainers 0
  960.     # Don't reuse a PropertyDialog:
  961.     # The initial size does not change to fit new contents.
  962.     require "propertydi.tcl"
  963.     PropertyDialog new $wmttoolObj.editProperties $wmttoolObj \
  964.         -editable 0 \
  965.         -title "Show Properties" \
  966.         -helpPressed {.main helpOnName editProperties}
  967.     $wmttoolObj.editProperties popUp
  968.     }
  969. }
  970.  
  971. proc BrowserProcs::splitAssociations {associations} {
  972.     set id [lsearch -regexp $associations Set]
  973.     if {$id > 0} {
  974.     set db_associations [lrange $associations 0 [expr $id - 1]]
  975.     } else {
  976.     set db_associations ""
  977.     }
  978.     if {$id >= 0} {
  979.     set ui_associations [lrange $associations $id end]
  980.     } else {
  981.     set ui_associations ""
  982.     }
  983.     return [list $db_associations $ui_associations]
  984. }
  985.  
  986. proc BrowserProcs::statusObjectsAre {status} {
  987.     case "[$wmttoolObj getStatus $status]" in {
  988.     {yes} {
  989.         return 1
  990.     }
  991.     {no} {
  992.         return 0
  993.     }
  994.     {default} {
  995.         foreach obj [$wmttoolObj selectedObjSet] {
  996.         set objStatus [$obj getInfo Status]
  997.         if {"$objStatus" == ""} continue
  998.         if {("$objStatus" != "reused" &&
  999.              [$obj getInfo "In Corporate"] == "Yes") ||
  1000.             "$objStatus" != "$status"} {
  1001.             $wmttoolObj setStatus "$status" no
  1002.             return 0
  1003.         }
  1004.         }
  1005.         $wmttoolObj setStatus "$status" yes
  1006.         return 1
  1007.     }
  1008.     }
  1009. }
  1010.  
  1011. proc BrowserProcs::statusObjectsAreNot {status} {
  1012.     case "[$wmttoolObj getStatus not$status]" in {
  1013.     {yes} {
  1014.         return 1
  1015.     }
  1016.     {no} {
  1017.         return 0
  1018.     }
  1019.     {default} {
  1020.         foreach obj [$wmttoolObj selectedObjSet] {
  1021.         set objStatus [$obj getInfo Status]
  1022.         if {"$objStatus" == ""} continue
  1023.         if {"$objStatus" == "$status"} {
  1024.             $wmttoolObj setStatus "not$status" no
  1025.             return 0
  1026.         }
  1027.         }
  1028.         $wmttoolObj setStatus "not$status" yes
  1029.         return 1
  1030.     }
  1031.     }
  1032. }
  1033.  
  1034. proc BrowserProcs::string2Action {actions} {
  1035.     BrowserProcs::initializeActionTable
  1036.  
  1037.     set map 0
  1038.     foreach action $actions {
  1039.     for {set actionMap 1} \
  1040.         {$actionMap <= 512} \
  1041.         {set actionMap [expr $actionMap << 1]} {
  1042.         if {$actionTable($actionMap) == $action} {
  1043.         set map [expr $map | $actionMap]
  1044.         break
  1045.         }
  1046.     }
  1047.     }
  1048.     return $map
  1049. }
  1050.  
  1051. proc BrowserProcs::typeObjectsAre {type} {
  1052.     case "[$wmttoolObj getStatus $type]" in {
  1053.     {yes} {
  1054.         return 1
  1055.     }
  1056.     {no} {
  1057.         return 0
  1058.     }
  1059.     {default} {
  1060.         foreach obj [$wmttoolObj selectedObjSet] {
  1061.         if {"[$obj getInfo Type]" != "$type"} {
  1062.             $wmttoolObj setStatus "$type" no
  1063.             return 0
  1064.         }
  1065.         }
  1066.         $wmttoolObj setStatus "$type" yes
  1067.         return 1
  1068.     }
  1069.     }
  1070. }
  1071.  
  1072. proc BrowserProcs::unfreezeObjects {} {
  1073.     set script ""
  1074.     foreach obj [$wmttoolObj selectedObjSet] {
  1075.     if {"$script" != ""} {
  1076.         append script " ;"
  1077.     }
  1078.     append script " $obj unfreeze"
  1079.     }
  1080.     $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  1081. }
  1082.  
  1083. proc BrowserProcs::userRoles {} {
  1084.     set securityLevel [[ClientContext::global] currentSecurityLevel]
  1085.     if [$securityLevel isNil] {
  1086.     set securityLevel [$wmttoolObj corporateObj]
  1087.     }
  1088.  
  1089.     set currentUser [BrowserProcs::currentUser]
  1090.     set userRoleList ""
  1091.     while {[$securityLevel isA SecurityLevel]} {
  1092.     foreach roleL [$securityLevel roleLinks $currentUser] {
  1093.         set role [$roleL role]
  1094.         set roleName "[$role name]"
  1095.         if {[lsearch -exact $userRoleList "$roleName"] == -1} {
  1096.         lappend userRoleList $roleName
  1097.         }
  1098.     }
  1099.     set securityLevel [$securityLevel upperLevel]
  1100.     }
  1101.     return $userRoleList
  1102. }
  1103.  
  1104. proc BrowserProcs::createShellLink {} {
  1105.     set objList [$wmttoolObj selectedObjSet]
  1106.     if [lempty $objList] {
  1107.     return
  1108.     }
  1109.     set cc [ClientContext::global]
  1110.     set lvlBase [$cc currentLevelString]
  1111.     foreach obj $objList {
  1112.     if [catch {set shl [ShellLink new]} msg] {
  1113.         # NT 3.51? ignore
  1114.         wmtkerror $msg
  1115.         return
  1116.     }
  1117.     set file [$obj file]
  1118.     set fName [$file qualifiedName /].[$file type]
  1119.     set lvl $lvlBase/$fName
  1120.  
  1121.     $shl path [m4_path_name bin otk.exe]
  1122.     $shl arguments "[quoteIf [m4_path_name tcl ude.tcl]] -- $lvl"
  1123.     set guiName \
  1124.      "[$file qualifiedName " "] [ShortLongName::longName [$file type]].lnk"
  1125.  
  1126.     set dir [registry get HKEY_CURRENT_USER \
  1127.     "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"             Desktop]
  1128.  
  1129.     $shl createIt $dir\\$guiName
  1130.     }
  1131. }
  1132.  
  1133. proc BrowserProcs::mergeConfigurations {} {
  1134.  
  1135.     set sel [lindex [.main selectedObjSet] 0]
  1136.     set names ""
  1137.     foreach obj [[.main flatView] objectSet] {
  1138.         set obj [$obj browsUiObj]
  1139.         if {$obj == $sel} {
  1140.             continue
  1141.         }
  1142.         lappend names [$obj getInfo Name].[$obj getInfo Version]
  1143.         lappend objects $obj
  1144.     }
  1145.  
  1146.     if {$names == ""} {
  1147.         wmtkinfo "No other Configuration to choose from."
  1148.         return
  1149.     }
  1150.  
  1151.     ListDialog new .main.mergeDialog
  1152.     .main.mergeDialog entrySet $names
  1153.     .main.mergeDialog selectionPolicy SINGLE
  1154.     .main.mergeDialog title "Select Merge Source"
  1155.     .main.mergeDialog helpPressed { .main helpOnName merge }
  1156.     .main.mergeDialog okPressed {
  1157.         set config1 [lindex [.main selectedObjSet] 0]
  1158.         set selName [lindex [%this selectedSet] 0]
  1159.         if {$selName == ""} {
  1160.             return
  1161.         }
  1162.         set cc [[ClientContext::global] currentLevelIdString]
  1163.         set tc $cc/[$config1 identity]
  1164.         foreach obj [[.main flatView] objectSet] {
  1165.             set obj [$obj browsUiObj]
  1166.             set name [$obj getInfo Name].[$obj getInfo Version]
  1167.             if {$name == $selName} {
  1168.                 set config2 $obj
  1169.                 break;
  1170.             }
  1171.         }
  1172.         set fc $cc/[$config2 identity]
  1173.  
  1174.         set script "SystemUtilities::fork otk mtmerge"
  1175.         set script "$script -c [list [get_comm_name]] -fc $fc -tc $tc"
  1176.         set endScript ""
  1177.         set message "Starting Merge Tool"
  1178.             .main startCommand tcl \
  1179.         "$script" "$endScript" "$message" {0 0} 0
  1180.     }
  1181.     .main.mergeDialog popUp
  1182. }
  1183.  
  1184. proc BrowserProcs::mergePhasesOnSystemLevel {{withPrevious ""}} {
  1185.  
  1186.     set sel [lindex [.main selectedObjSet] 0]
  1187.     if [$sel isA PhaseVersion] {
  1188.         BrowserProcs::importPhases $withPrevious
  1189.         return
  1190.     }
  1191.  
  1192.     set phase [$sel getParent PhaseVersion]
  1193.  
  1194.     if {[$phase getInfo Type] == "Implementation"} {
  1195.         wmtkinfo "Can not merge into phase 'Implementation'."
  1196.         return
  1197.     }
  1198.  
  1199.     set sysName [[$sel system] name]
  1200.     set sysType [[$sel system] type]
  1201.  
  1202.     set cc [ClientContext::global]
  1203.     set curPhase [$cc currentPhase]
  1204.     set curConfig [$cc currentConfig]
  1205.  
  1206.     if {$withPrevious != ""} {
  1207.         set previousPhase [$phase previous $curConfig]
  1208.         if [$previousPhase isNil] {
  1209.             wmtkinfo "Previous phase not found"
  1210.         } else {
  1211.             set sys [$previousPhase findSystemVersion $sysName $sysType]
  1212.             if [$sys isNil] {
  1213.             wmtkinfo "System '$sysName' not found in previous phase"
  1214.             } else {
  1215.             set sId [$sys identity]
  1216.             set pId [$previousPhase identity]
  1217.             BrowserProcs::doMergePhasesOnSystemLevel $sel $sId $pId
  1218.             }
  1219.         }
  1220.         return
  1221.     }
  1222.  
  1223.     set names ""
  1224.     set objects ""
  1225.     foreach phase [$curConfig phaseVersions] {
  1226.         if {[[$phase phase] type] == "Implementation"} {
  1227.             continue
  1228.         }
  1229.         if {$phase == $curPhase} {
  1230.             continue
  1231.         }
  1232.         set sys [$phase findSystemVersion $sysName $sysType]
  1233.         if [$sys isNil] {
  1234.             continue
  1235.         }
  1236.         lappend names [[$phase phase] name].[$phase versionName]
  1237.         lappend objects "$phase $sys"
  1238.     }
  1239.  
  1240.     if {$names == ""} {
  1241.         wmtkinfo "[cap $sysType] '$sysName' not found in another phase."
  1242.         return
  1243.     }
  1244.     ClassMaker::extend ListDialog ImportSysDialog objects
  1245.     ImportSysDialog new .main.importDialog2
  1246.     .main.importDialog2 entrySet $names
  1247.     .main.importDialog2 objects $objects
  1248.     .main.importDialog2 selectionPolicy SINGLE
  1249.     .main.importDialog2 title "Select Merge Source"
  1250.     .main.importDialog2 helpPressed { .main helpOnName selectImportSource }
  1251.     .main.importDialog2 okPressed {
  1252.         set sys1 [lindex [.main selectedObjSet] 0]
  1253.         set sel [lindex [%this objects] [%this selectedIndexSet]]
  1254.         set phase2 [[lindex $sel 0] identity]
  1255.         set sys2 [[lindex $sel 1] identity]
  1256.         BrowserProcs::doMergePhasesOnSystemLevel $sys1 $sys2 $phase2
  1257.     }
  1258.     .main.importDialog2 popUp
  1259. }
  1260.  
  1261. proc BrowserProcs::doMergePhasesOnSystemLevel {sys1 sys2 phase2} {
  1262.  
  1263.     set cc [ClientContext::global]
  1264.     set tc [$cc currentLevelIdString]/[$sys1 identity]
  1265.  
  1266.     set corp2 [[$cc currentCorporate] identity]
  1267.     set proj2 [[$cc currentProject] identity]
  1268.     set conf2 [[$cc currentConfig] identity]
  1269.  
  1270.     set fc "/$corp2/$proj2/$conf2/$phase2/$sys2"
  1271.  
  1272.     set script "SystemUtilities::fork otk mtmerge"
  1273.     set script "$script -c [list [get_comm_name]] -fc $fc -tc $tc"
  1274.     set endScript ""
  1275.     set message "Starting Merge From Other Phase"
  1276.     .main startCommand tcl \
  1277.     "$script" "$endScript" "$message" {0 0} 0
  1278. }
  1279.  
  1280. proc BrowserProcs::mergePhases {{withPrevious ""}} {
  1281.  
  1282.     set sel [lindex [.main selectedObjSet] 0]
  1283.  
  1284.     if [$sel isA SystemVersion] {
  1285.         BrowserProcs::mergePhasesOnSystemLevel $withPrevious
  1286.         return
  1287.     }
  1288.  
  1289.     set cc [ClientContext::global]
  1290.     set curConfig [$cc currentConfig]
  1291.     set curPhase [$cc currentPhase]
  1292.     set curPhase $sel
  1293.  
  1294.     if {[$curPhase getInfo Type] == "Implementation"} {
  1295.         wmtkinfo "Can not merge into phase 'Implementation'."
  1296.         return
  1297.     }
  1298.  
  1299.     if {$withPrevious != ""} {
  1300.         set previousPhase [$curPhase previous $curConfig]
  1301.         if [$previousPhase isNil] {
  1302.             wmtkinfo "Previous phase not found"
  1303.         } else {
  1304.             BrowserProcs::doMergePhases $curPhase $previousPhase
  1305.         }
  1306.         return
  1307.     }
  1308.  
  1309.     set names ""
  1310.     set objects ""
  1311.     foreach phase [$curConfig phaseVersions] {
  1312.         if {[[$phase phase] type] == "Implementation"} {
  1313.             continue
  1314.         }
  1315.         if {$phase == $curPhase} {
  1316.             continue
  1317.         }
  1318.         lappend names [[$phase phase] name].[$phase versionName]
  1319.         lappend objects $phase
  1320.     }
  1321.  
  1322.     if {$names == ""} {
  1323.         wmtkinfo "No other phase to merge from."
  1324.         return
  1325.     }
  1326.     ClassMaker::extend ListDialog ImportPhaseDialog objects
  1327.     ImportPhaseDialog new .main.importDialog
  1328.     .main.importDialog entrySet $names
  1329.     .main.importDialog objects $objects
  1330.     .main.importDialog selectionPolicy SINGLE
  1331.     .main.importDialog title "Select Merge Source"
  1332.     .main.importDialog helpPressed { .main helpOnName selectImportSource }
  1333.     .main.importDialog okPressed {
  1334.         set phase1 [lindex [.main selectedObjSet] 0]
  1335.         set selName [lindex [%this selectedSet] 0]
  1336.         if {$selName == ""} {
  1337.             return
  1338.         }
  1339.         foreach obj [%this objects] {
  1340.             set name [$obj getInfo Name].[$obj getInfo Version]
  1341.             if {$name == $selName} {
  1342.                 set phase2 $obj
  1343.                 break;
  1344.             }
  1345.         }
  1346.         BrowserProcs::doMergePhases $phase1 $phase2
  1347.     }
  1348.     .main.importDialog popUp
  1349. }
  1350.  
  1351. proc BrowserProcs::doMergePhases {phase1 phase2} {
  1352.  
  1353.     set cc [[ClientContext::global] currentLevelIdString]
  1354.     set curPhase [[ClientContext::global] currentPhase]
  1355.     if [$curPhase isNil] {
  1356.         set tc $cc/[$phase1 identity]
  1357.     } else {
  1358.         # do nothing, in the right context
  1359.         set tc $cc
  1360.     }
  1361.     if [$curPhase isNil] {
  1362.         set fc $cc/[$phase2 identity]
  1363.     } else {
  1364.         set gcc [ClientContext::global]
  1365.         set corp [[$gcc currentCorporate] identity]
  1366.         set proj [[$gcc currentProject] identity]
  1367.         set config [[$gcc currentConfig] identity]
  1368.         set fc /$corp/$proj/$config/[$phase2 identity]
  1369.     }
  1370.  
  1371.     set script "SystemUtilities::fork otk mtmerge"
  1372.     set script "$script -c [list [get_comm_name]] -fc $fc -tc $tc"
  1373.     set endScript ""
  1374.     set message "Starting Merge From Other Phase"
  1375.     .main startCommand tcl \
  1376.     "$script" "$endScript" "$message" {0 0} 0
  1377. }
  1378.  
  1379. # Do not delete this line -- regeneration end marker
  1380.  
  1381.