home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / vbrowser.tcl < prev    next >
Text File  |  1997-11-25  |  3KB  |  143 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)vbrowser.tcl    /main/titanic/10
  6. #      Author:         voyager
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)vbrowser.tcl    /main/titanic/10   25 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. if {[info tclversion] != 7.3} {
  12.  
  13.     proc fmtclock {clockval format} {
  14.     return [clock format $clockval -format $format]
  15.     }
  16. }
  17.  
  18. OtkRegister::extGui
  19. OtkRegister::reportWriter
  20.  
  21. source [m4_path_name tcl libocl.tcl]
  22.  
  23. global classCount
  24. set classCount 0
  25.  
  26. global globalModuleHandler
  27. set globalModuleHandler [ModuleHandler new]
  28.  
  29. $globalModuleHandler moduleSpecSetChanged {
  30.         set s_modules [%this selectedModuleSpecSet]
  31.         foreach file [%this getFiles tcl s_desk.tcl $s_modules] {
  32.         source $file
  33.         }
  34.     }
  35.  
  36. require platform.tcl
  37. require "procs.tcl"
  38. require "browserpro.tcl"
  39. require "messagehdl.tcl"
  40. require "versionbro.tcl"
  41.  
  42. require "vbprocs.tcl"
  43. require "vbfilemenu.tcl"
  44. require "vbeditmenu.tcl"
  45. require "vbviewmenu.tcl"
  46. require "vboptionme.tcl"
  47. require "vbversionm.tcl"
  48. require "vbsymb2url.tcl"
  49.  
  50. proc usage {} {
  51.     error "Usage: otk vbrowser.tcl -- \[-c caller\] -v version"
  52. }
  53.  
  54. set argc 0
  55. set status INITIAL
  56. set context ""
  57. set caller ""
  58. set versionId ""
  59. foreach arg $argv {
  60.     case $arg in {
  61.     {-c} {
  62.         if {$status != "INITIAL"} {
  63.         usage
  64.         }
  65.         set status CALLER
  66.     }
  67.     {-v} {
  68.         set status VERSION
  69.     }
  70.     {default} {
  71.         case $status in {
  72.         {VERSION} {
  73.             set versionId $arg
  74.             set status END
  75.         }
  76.         {CALLER} {
  77.             set caller $arg
  78.             set status CONTEXT
  79.         }
  80.         {CONTEXT} {
  81.             append context " $arg"
  82.         }
  83.         {default} {
  84.             usage
  85.         }
  86.         }
  87.     }
  88.     }
  89.     incr argc 1
  90. }
  91.  
  92. if {$status != "END"} {
  93.     usage
  94. }
  95.  
  96. # show more information the the default information shown
  97. # in the browser
  98. global BrowserProcs::infoProperties
  99. set BrowserProcs::infoProperties \
  100.     "${BrowserProcs::infoProperties} \"Selected In\" \"Merged From\""
  101.  
  102. # be sure that the client context do NOT include the version
  103. set currentLevel [[ClientContext::global] currentCustomLevel]
  104. eval [$globalModuleHandler moduleSpecSetChanged]
  105. set version [VBProcs::id2Obj $versionId]
  106. if {$currentLevel == $version} {
  107.     [ClientContext::global] upLevel
  108. }
  109.  
  110. set config [[ClientContext::global] currentConfig]
  111. set phase [[ClientContext::global] currentPhase]
  112. if ![$phase  isNil] {
  113.     $phase parent $config
  114.     set system [[ClientContext::global] currentSystem]
  115.     if ![$system isNil] {
  116.         $system parent $phase
  117.     }
  118. }
  119.  
  120. sourceOptional u_vbrowser
  121.  
  122. VersionBrowser new .main vbrowser -closed {%this stop}
  123. if [isCommand .main.error] {
  124.     .main.error okPressed "%this delete; .main stop"
  125.     return
  126. }
  127.  
  128. .main config \
  129.     -title "ObjectTeam VersionBrowser" \
  130.     -iconTitle "ObjectTeam VersionBrowser" \
  131.     -caller "$caller" \
  132.     -currentVersion $version \
  133.     -firstExposed {%this initialize}
  134.  
  135. if {! $win95} {
  136.     .main icon desk_64
  137. }
  138.  
  139. .main popUp
  140. .main ready
  141. .main cursor DEFAULT
  142.  
  143.