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