home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / desk.tcl < prev    next >
Text File  |  1997-05-16  |  3KB  |  121 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1995
  4. #
  5. #      File:           @(#)desk.tcl    /main/hindenburg/9
  6. #      Author:         Marcel Bancken
  7. #      Description:    Instantiation of the desk
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)desk.tcl    /main/hindenburg/9   16 May 1997 Copyright 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 "browser.tcl"
  19.  
  20. proc usage {} {
  21.     error "Usage: otk desk.tcl -- \[-c caller\] ?objectId?"
  22. }
  23.  
  24. set argc 0
  25. set status INITIAL
  26. set context ""
  27. set caller ""
  28. foreach arg $argv {
  29.     case $arg in {
  30.     {-c} {
  31.         if {$status != "INITIAL"} {
  32.         usage
  33.         }
  34.         set status CALLER
  35.     }
  36.     {default} {
  37.         case $status in {
  38.         {CALLER} {
  39.             set caller $arg
  40.             set status CONTEXT
  41.         }
  42.         {CONTEXT} {
  43.             append context " $arg"
  44.         }
  45.         {default} {
  46.             usage
  47.         }
  48.         }
  49.     }
  50.     }
  51.     incr argc 1
  52. }
  53. if {$status != "INITIAL" && $status != "CONTEXT"} {
  54.     usage
  55. }
  56.  
  57. # Go one level up until the ClientContext is valid
  58. set invalidContext [catch {set clientContext [ClientContext::global]} errorMsg]
  59. if $invalidContext {
  60.     set clientContext [ClientContext::global]
  61.     for {set levelpath [m4_var get M4_levelpath]} \
  62.     {$invalidContext} \
  63.     {set invalidContext \
  64.         [catch {$clientContext setLevelPath $levelpath} errorMsg]} {
  65.     set slash [string last "/" $levelpath]
  66.     if {$slash <= 0} break
  67.     set levelpath [string range $levelpath 0 [expr $slash - 1]]
  68.     }
  69. }
  70. if $invalidContext {
  71.     wmtkfatal $errorMsg
  72.     return
  73. }
  74.  
  75. # If the initial context is still empty then 
  76. # it is specified by M4_levelpath_ids
  77. if {"$context" == ""} {
  78.     set levelpath_ids [m4_var get M4_levelpath_ids]
  79.     for {set slash [string last "/" $levelpath_ids]} \
  80.     {$slash >= 0} \
  81.     {set slash [string last "/" $levelpath_ids]} {
  82.     set context \
  83.         "[string range $levelpath_ids [expr $slash + 1] end] $context"
  84.     set levelpath_ids [string range $levelpath_ids 0 [expr $slash - 1]]
  85.     }
  86. }
  87.  
  88. set rootIdList [list \
  89.     [list Corporate [[$clientContext currentCorporate] identity]] \
  90.     [list UCustFUiObj "${UCustFUiObj::uiClass}:0"] \
  91. ]
  92.  
  93. sourceOptional u_desk
  94.  
  95. # sport7 addition for vcm integrations
  96. set corporate [$clientContext currentCorporate]
  97. if [$corporate isA Corporate] {
  98.     if { [$corporate getPropertyValue vcmIntegrationList] != "" } {
  99.     require vsbr_procs.tcl
  100.     }
  101. }
  102.  
  103. Browser new .main -closed {%this stop}
  104. if [isCommand .main.error] {
  105.     .main.error okPressed "%this delete; .main stop"
  106.     return
  107. }
  108. .main config \
  109.     -title "ObjectTeam Browser" \
  110.     -iconTitle "ObjectTeam Browser" \
  111.     -initialContext $context \
  112.     -rootIdList $rootIdList \
  113.     -caller "$caller" \
  114.     -firstExposed {%this initView}
  115.  
  116. if {! $win95} {
  117.     .main icon desk_64
  118. }
  119.  
  120. .main popUp
  121.