home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / ude.tcl < prev    next >
Text File  |  1997-11-27  |  3KB  |  133 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1995
  4. #
  5. #      File:           @(#)ude.tcl    /main/titanic/6
  6. #      Author:         Fred Mol
  7. #      Description:    main ude.tcl
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)ude.tcl    /main/titanic/6    27 Nov 1997Copyright 1995 Westmount Technology
  10.  
  11. OtkRegister::extGui
  12.  
  13. source [m4_path_name tcl libocl.tcl]
  14.  
  15. require platform.tcl
  16. require procs.tcl
  17. require messagehdl.tcl
  18. require caynutil.tcl
  19.  
  20. proc usage {} {
  21.     error "Usage: otk ude.tcl -- \
  22.         \[-c caller\] \
  23.         \[-r\] \
  24.         levelPath | levelPathIds"
  25. }
  26.  
  27. set argc 0
  28. set status INITIAL
  29. set readOnly 0
  30. set caller ""
  31. foreach arg $argv {
  32.     case $arg in {
  33.         {-c} {
  34.         if {$status != "INITIAL"} {
  35.             usage
  36.         }
  37.         set status CALLER
  38.         }
  39.         {-r} {
  40.         if {$status != "INITIAL"} {
  41.             usage
  42.         }
  43.         set readOnly 1
  44.         }
  45.         {default} {
  46.         case $status in {
  47.             {CALLER} {
  48.             set caller $arg
  49.             set status INITIAL
  50.             }
  51.             {INITIAL} {
  52.                 set idx [lsearch $argv $arg]
  53.             set currArg $idx
  54.             incr idx 3
  55.             set argvl [llength $argv]
  56.             if {$idx == $argvl} {
  57.                 # old style open: with fileV,systemV,configV
  58.                 # for compatibility, try to avoid usage
  59.                 set fvArg [lindex $argv $currArg]
  60.                 incr currArg
  61.                 set svArg [lindex $argv $currArg]
  62.                 incr currArg
  63.                 set cvArg [lindex $argv $currArg]
  64.  
  65.                 if [catch {set fv [Graph new $fvArg]}] {
  66.                     usage
  67.                 }
  68.                 if [catch {set sv [SystemVersion new $svArg]}] {
  69.                     usage
  70.                 }
  71.                 if [catch {set cv [ConfigVersion new $cvArg]}] {
  72.                     usage
  73.                 }
  74.  
  75.                 set cc [ClientContext::global]
  76.                 set corp [$cc currentCorporate]
  77.                 set proj [$cv project]
  78.                 set phase \
  79.                     [$cv findPhaseVersion -byPhase [$sv phase]]
  80.                 set str /[$corp identity]
  81.                 append str /[$proj identity]
  82.                 append str /[$cv identity]
  83.                 append str /[$phase identity]
  84.                 append str /[$sv identity]
  85.                 append str /[$fv identity]
  86.                 set levelPath $str
  87.                 incr argc 2
  88.             } else {
  89.                 # levelpath 
  90.                 if [catch {set levelPath $arg}] {
  91.                     usage
  92.                 }
  93.                 
  94.             }
  95.             set status LEVELPATH
  96.             }
  97.             {LEVELPATH} {
  98.                 break
  99.             }
  100.             {default} {
  101.             usage
  102.             }
  103.         }
  104.         }
  105.     }
  106.     incr argc 1
  107. }
  108. if {$status != "LEVELPATH"} {
  109.     usage
  110. }
  111. if [catch {set levelPathObj [LevelPath new $levelPath]}] {
  112.     usage
  113. }
  114. if [catch {set fv [$levelPathObj nameAt File]}] {
  115.     usage
  116. }
  117. if [isObjectId $fv Graph:] {
  118.     set type [[[Graph new $fv] file] type]
  119. } else {
  120.     set type [nt_get_type $levelPath]
  121. }
  122.  
  123. require "${type}editor.tcl"
  124. sourceOptional u_ude
  125.  
  126. [string toupper $type]Editor new .main \
  127.     -permanentReadOnly $readOnly \
  128.     -caller "$caller" \
  129.     -diagramType $type \
  130.     -firstExposed ".main startEdit $levelPath"
  131. .main popUp
  132. .main ready
  133.