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