home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / drsude.tcl < prev    next >
Text File  |  1997-09-23  |  6KB  |  209 lines
  1. # Copyright (c) 1997 by Cayenne Software Inc.
  2. #
  3. # This software is furnished under a license and may be used only in
  4. # accordance with the terms of such license and with the inclusion of
  5. # the above copyright notice. This software or any other copies thereof
  6. # may not be provided or otherwise made available to any other person.
  7. # No title to and ownership of the software is hereby transferred.
  8. #
  9. # The information in this software is subject to change without notice
  10. # and should not be construed as a commitment by Cayenne Software Inc
  11. #
  12. #---------------------------------------------------------------------------
  13. #
  14. #       File            : @(#)drsude.tcl    /main/titanic/4 23 Jan 1997
  15. #       Author          : H. Broeze
  16. #       Original date   : 14 Januari 1997
  17. #       Description     : DOORS navigation to ObjectTeam
  18. #
  19. #---------------------------------------------------------------------------
  20. #
  21.  
  22.  
  23. OtkRegister::extGui
  24.  
  25. source [m4_path_name tcl libocl.tcl]
  26.  
  27. require platform.tcl
  28. require procs.tcl
  29. require messagehdl.tcl
  30.  
  31. set caller ""
  32. set args $argv
  33. regsub -all {\\} $args "" args
  34. set parentOTVersionsOfFileDict [Dictionary new]
  35. set parentOTVersionsOfSystemDict [Dictionary new]
  36. set parentOTVersionsOfPhaseDict [Dictionary new]
  37. set projSelectedItems [lindex $args 0]
  38.  
  39. global projName
  40. global configVersion 
  41. global phaseVerison
  42. global systemVersion 
  43. set configVersion ""
  44. set systemVersion ""
  45. set fileVersion ""
  46.  
  47. set projName [lindex $args 1]
  48. if {[llength $args] >= 5} {
  49.     set phaseName [lindex $args 3]
  50.     $parentOTVersionsOfPhaseDict contents [lindex $args 4]
  51. }
  52. if {[llength $args] >= 7} {
  53.     set systemName [lindex $args 5] 
  54.     $parentOTVersionsOfSystemDict contents [lindex $args 6]
  55. }
  56.  
  57. if {[llength $args] == 11 || [llength $args] == 12} {
  58.     set fileType [lindex $args 7]
  59.     set fileName [lindex $args 9] 
  60.     $parentOTVersionsOfFileDict contents [lindex $args 10]
  61. }
  62. if {[llength $args] >= 15} {
  63.     set fileType [lindex $args 11]
  64.     set fileName [lindex $args 9]/[lindex $args 13] 
  65.     $parentOTVersionsOfFileDict contents [lindex $args 14]
  66. }
  67. set configOptions ""
  68. if [catch {set cc [ClientContext::global]}] {
  69.     set cc [ClientContext::global]
  70. }
  71. set corporate [$cc currentCorporate]
  72. set proj [$corporate findProject $projName]
  73. if [$proj isNil] {
  74.     wmtkerror "Project with name '$projName' does not exist"
  75.     .main popUp
  76.     return
  77. }
  78. $parentOTVersionsOfFileDict foreach fileVersion systemVersions {
  79.     foreach systemVersion $systemVersions {
  80.     foreach phaseV [$parentOTVersionsOfSystemDict set $systemVersion] {
  81.         foreach confVId [$parentOTVersionsOfPhaseDict set $phaseV] {
  82.         if {[lsearch $configOptions $confVId] == -1} {
  83.             lappend configOptions $confVId
  84.         }
  85.         }
  86.     }
  87.     }
  88. }
  89.         
  90. require "diagramedi.tcl"
  91.  
  92. sourceOptional u_ude
  93. set editorType $fileType
  94. set type $fileType
  95.  
  96. if {[string length $fileType] != 3 && $fileType != "Attribute" && $fileType != "Operation"} {
  97.     set editorType [lindex $args 11]
  98. }
  99.  
  100. require "${editorType}editor.tcl"
  101. [string toupper $editorType]Editor new .main \
  102.     -caller "$caller" 
  103.  
  104. set fileDict [Dictionary new]
  105. proc selectFromObject {confV phaseV systemV itemName itemType } {
  106.     set workItem [$systemV findDeclaration $itemName cl $confV]
  107.     set item [$workItem item]
  108.     $item getDecompositions $phaseV $systemV decompComponents $editorType resultSystems resultFiles
  109.     set fileNames ""
  110.     foreach graph $resultFiles {
  111.     set fileName  [[$graph file] name]
  112.     $fileDict set $fileName $graph
  113.     lappend fileNames $fileName
  114.     }
  115.     if {[llength $fileNames] == 0} {
  116.     wmtkinfo "$itemType $itemName does not exist in any $editorType diagram" 
  117.     }
  118.     if {[llength $fileNames] ==  1} {
  119.     fileSelected $confV $systemV [$fileDict set $fileNames]
  120.     }
  121.     if {[llength $fileNames] > 1} {
  122.     ListDialog new .main.selectFile \
  123.         -message "Select File Name/Version"\
  124.         -okPressed { 
  125.             set selFileName [.main.selectFile selectedSet]
  126.             global fileVersion
  127.             set fileVersion [$fileDict set $selFileName]
  128.             #.main fileVersion $fileVersion
  129.             startEdit 
  130.         }
  131.     .main.selectFile entrySet $fileNames
  132.     .main.selectFile popUp
  133.     }
  134.     global configVersion
  135.     set configVersion $confV
  136.     global systemVersion
  137.     set systemVersion $systemV
  138.     .main popUp
  139. }
  140. proc findFile { $proj configV } {
  141.     set configVList [split $configV .]
  142.      set confName [lindex $configVList 0]
  143.      set confVersion [lindex $configVList 1]
  144.     set configV [$proj findConfigVersion $confName $confVersion]
  145.     set phaseV [$configV findPhaseVersion $phaseName $phaseName]
  146.     set systemV [$phaseV findSystemVersion $systemName system]
  147.     if {[lsearch "Class UseCase" $fileType] != -1} {
  148.         selectFromObject $configV $phaseV $systemV $fileName $fileType
  149.     } else {
  150.         set fileV [$systemV findFileVersion $fileName $fileType]
  151.         if ![$fileV isNil] {
  152.         fileSelected $configV $systemV $fileV
  153.         } else {
  154.         global configVerison
  155.             global systemVersion
  156.         set configVersion $configV 
  157.         set systemVersion $systemV
  158.         if {[string length $fileType] > 3} { 
  159.             wmtkinfo "${fileType}s are not supported for navigation"
  160.         } else {
  161.             wmtkinfo "$fileType $fileName does not exist" 
  162.         }
  163.         }
  164.     }
  165. }
  166.  
  167. proc startEdit {} {
  168.     set cc [ClientContext::global]
  169.     set corp [$cc currentCorporate]
  170.     set proj [$configVersion project]
  171.     set phase [$configVersion findPhaseVersion -byPhase [$systemVersion phase]]
  172.     set str /[$corp identity]
  173.     append str /[$proj identity]
  174.     append str /[$configVersion identity]
  175.     append str /[$phase identity]
  176.     append str /[$systemVersion identity]
  177.     append str /[$fileVersion identity]
  178.     
  179.     set file [$fileVersion file]
  180.     set type [$file type]
  181.     .main diagramType $type
  182.     .main startEdit $str
  183. }
  184.  
  185. proc fileSelected { configV systemV fileV} { 
  186.     global configVersion
  187.     global systemVersion
  188.     global fileVersion
  189.     set configVersion $configV
  190.     set systemVersion $systemV
  191.     set fileVersion $fileV
  192.     startEdit
  193. }
  194.  
  195. if {[llength $configOptions] > 1 } {
  196.     ListDialog new .main.listDialog \
  197.     -message "Select Configuration Name/Version"\
  198.     -okPressed { 
  199.             .main popUp
  200.             .main ready
  201.             findFile $proj [.main.listDialog selectedSet]
  202.     }
  203.     .main.listDialog entrySet $configOptions
  204.     .main.listDialog popUp
  205. } else {
  206.     findFile $proj $configOptions
  207.     .main popUp
  208. }
  209.