home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / cldispatch.tcl < prev    next >
Text File  |  1996-06-12  |  7KB  |  272 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)cldispatch.tcl    /main/3
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)cldispatch.tcl    /main/3   12 Jun 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12.  
  13. require platform.tcl
  14. require systemutil.tcl
  15.  
  16. # End user added include file section
  17.  
  18.  
  19. # Definition of Dispatcher class.
  20. # This class handles the startup of exetools and the
  21. # communication between exetools and the dispatcher.
  22.  
  23. Class ClDispatcher : {Object} {
  24.     method destructor
  25.     constructor
  26.     method addFreeMtool
  27.     method removeFreeMtool
  28.     method addFreeXtool
  29.     method removeFreeXtool
  30.     method addMtoolRequest
  31.     method removeMtoolRequest
  32.     method addXtoolRequest
  33.     method removeXtoolRequest
  34.     method addAllTool
  35.     method removeAllTool
  36.     attribute clientCount
  37.     attribute id
  38.     attribute freeMtoolSet
  39.     attribute freeXtoolSet
  40.     attribute mtoolRequestSet
  41.     attribute xtoolRequestSet
  42.     attribute allToolSet
  43. }
  44.  
  45. global ClDispatcher::dispatcher
  46. set ClDispatcher::dispatcher ""
  47.  
  48.  
  49. method ClDispatcher::destructor {this} {
  50.     # Start destructor user section
  51.     [$this allToolSet] foreach tool {
  52.         send -async $tool {${Exetool::exetool} stop}
  53.     }
  54.     # End destructor user section
  55. }
  56.  
  57. constructor ClDispatcher {class this name startUpTool} {
  58.     set this [Object::constructor $class $this $name]
  59.  
  60.     # Check this before doing a send command
  61.     if $win95 {
  62.     # should never show up
  63.     MainWindow new .main -title Dispatcher
  64.     PushButton new .main.push -label exit
  65.     }
  66.  
  67.     if {! [isRunning $startUpTool 1]} {
  68.     exit
  69.     }
  70.  
  71.     $this config \
  72.     -freeMtoolSet [List new] \
  73.     -freeXtoolSet [List new] \
  74.     -mtoolRequestSet [List new] \
  75.     -xtoolRequestSet [List new] \
  76.     -allToolSet [List new] \
  77.     -clientCount 1
  78.  
  79.     set tool [ClDispatcher::exists]
  80.     if {$tool != ""} {
  81.     # Another dispatcher is running. Register the client with
  82.     # that tool, return that one to the client and exit.
  83.     send $tool ClDispatcher::registerClient [list $startUpTool]
  84.     send -async $startUpTool WmtTool::dispatcherStarted [list $tool]
  85.     exit
  86.     }
  87.  
  88.     global ClDispatcher::dispatcher
  89.     set ClDispatcher::dispatcher $this
  90.  
  91.     set id [get_comm_name]
  92.     $this id $id
  93.  
  94.     send -async $startUpTool WmtTool::dispatcherStarted [list $id]
  95.  
  96.     return $this
  97. }
  98.  
  99.  
  100. # Check if another dispatcher is running
  101. # for the same host and user.
  102. # 
  103. #
  104. proc ClDispatcher::exists {} {
  105.     set tools [interps]
  106.     set dispatcher [get_comm_name]
  107.     foreach tool $tools {
  108.     if {("$tool" == "$dispatcher") ||
  109.         ("[lindex $tool 1]" != "[lindex $dispatcher 1]") ||
  110.         ("[lindex $tool 2]" != "[lindex $dispatcher 2]") ||
  111.         (! [isRunning "$tool"])} continue
  112.     if {"[lindex $tool 0]" == "[lindex $dispatcher 0]"} {
  113.         return $tool
  114.     }
  115.     }
  116.     return ""
  117. }
  118.  
  119. proc ClDispatcher::getFreeMtool {requester cmd {dir ""}} {
  120.     set this ${ClDispatcher::dispatcher}
  121.     set freeList [$this freeMtoolSet]
  122.     if [llength [$freeList contents]] {
  123.     set list [$this allToolSet]
  124.     for {set index 0; set freeIndex -1} {$freeIndex == -1} {incr index 1} {
  125.         set tool [$list index $index]
  126.         set freeIndex [lsearch -exact [$freeList contents] $tool]
  127.     }
  128.     $freeList remove $freeIndex
  129.     if [isRunning $tool] {
  130.         send -async $requester WmtTool::mtoolAvailable \
  131.         [list $tool] $cmd [list $dir]
  132.     } else {
  133.             ClDispatcher::mtoolDied $tool
  134.         ClDispatcher::getFreeMtool $requester $cmd $dir
  135.     }
  136.     } else {
  137.     $this addMtoolRequest $requester
  138.     SystemUtilities::fork otk mtool "[$this id]" $cmd [list $dir]
  139.     }
  140. }
  141.  
  142. proc ClDispatcher::getFreeXtool {requester cmd {dir ""}} {
  143.     set this ${ClDispatcher::dispatcher}
  144.     set freeList [$this freeXtoolSet]
  145.     if [llength [$freeList contents]] {
  146.     set list [$this allToolSet]
  147.     for {set index 0; set freeIndex -1} {$freeIndex == -1} {incr index 1} {
  148.         set tool [$list index $index]
  149.         set freeIndex [lsearch -exact [$freeList contents] $tool]
  150.     }
  151.     $freeList remove $freeIndex
  152.     if [isRunning $tool] {
  153.         send -async $requester WmtTool::xtoolAvailable \
  154.         [list $tool] $cmd [list $dir]
  155.     } else {
  156.             ClDispatcher::xtoolDied $tool
  157.         ClDispatcher::getFreeXtool $requester $cmd $dir
  158.     }
  159.     } else {
  160.     $this addXtoolRequest $requester
  161.     startXTool [$this id] $cmd [list $dir]
  162.     }
  163. }
  164.  
  165. proc ClDispatcher::mtoolStarted {mtool cmd {dir ""}} {
  166.     set this ${ClDispatcher::dispatcher}
  167.     set list [$this mtoolRequestSet]
  168.     set requester [$list index 0]
  169.     $list remove 0
  170.     send -async $requester WmtTool::mtoolAvailable [list $mtool] $cmd $dir
  171.     $this addAllTool $mtool
  172. }
  173.  
  174. proc ClDispatcher::mtoolUnavailable {mtool} {
  175.     ${ClDispatcher::dispatcher} removeFreeMtool $mtool
  176. }
  177.  
  178. proc ClDispatcher::mtoolAvailable {mtool} {
  179.     ${ClDispatcher::dispatcher} addFreeMtool $mtool
  180. }
  181.  
  182. proc ClDispatcher::mtoolDied {mtool} {
  183.     ${ClDispatcher::dispatcher} removeFreeMtool $mtool
  184.     ${ClDispatcher::dispatcher} removeAllTool $mtool
  185. }
  186.  
  187. proc ClDispatcher::xtoolStarted {xtool cmd {dir ""}} {
  188.     set this ${ClDispatcher::dispatcher}
  189.     set list [$this xtoolRequestSet]
  190.     set requester [$list index 0]
  191.     $list remove 0
  192.     send -async $requester WmtTool::xtoolAvailable [list $xtool] $cmd $dir
  193.     $this addAllTool $xtool
  194. }
  195.  
  196. proc ClDispatcher::xtoolUnavailable {xtool} {
  197.     ${ClDispatcher::dispatcher} removeFreeXtool $xtool
  198. }
  199.  
  200. proc ClDispatcher::xtoolAvailable {xtool} {
  201.     ${ClDispatcher::dispatcher} addFreeXtool $xtool
  202. }
  203.  
  204. proc ClDispatcher::xtoolDied {xtool} {
  205.     ${ClDispatcher::dispatcher} removeFreeXtool $xtool
  206.     ${ClDispatcher::dispatcher} removeAllTool $xtool
  207. }
  208.  
  209. proc ClDispatcher::registerClient {client} {
  210.     set this ${ClDispatcher::dispatcher}
  211.     $this clientCount [expr {[$this clientCount] + 1}]
  212. }
  213.  
  214. proc ClDispatcher::unregisterClient {client} {
  215.     set this ${ClDispatcher::dispatcher}
  216.     set cnt [$this clientCount]
  217.     incr cnt -1
  218.     if {$cnt == 0} {
  219.     $this delete
  220.     exit
  221.     }
  222.     $this clientCount $cnt
  223. }
  224.  
  225. # Do not delete this line -- regeneration end marker
  226.  
  227. method ClDispatcher::addFreeMtool {this newFreeMtool} {
  228.     [$this freeMtoolSet] append $newFreeMtool
  229.  
  230. }
  231.  
  232. method ClDispatcher::removeFreeMtool {this oldFreeMtool} {
  233.     [$this freeMtoolSet] removeValue $oldFreeMtool
  234. }
  235.  
  236. method ClDispatcher::addFreeXtool {this newFreeXtool} {
  237.     [$this freeXtoolSet] append $newFreeXtool
  238.  
  239. }
  240.  
  241. method ClDispatcher::removeFreeXtool {this oldFreeXtool} {
  242.     [$this freeXtoolSet] removeValue $oldFreeXtool
  243. }
  244.  
  245. method ClDispatcher::addMtoolRequest {this newMtoolRequest} {
  246.     [$this mtoolRequestSet] append $newMtoolRequest
  247.  
  248. }
  249.  
  250. method ClDispatcher::removeMtoolRequest {this oldMtoolRequest} {
  251.     [$this mtoolRequestSet] removeValue $oldMtoolRequest
  252. }
  253.  
  254. method ClDispatcher::addXtoolRequest {this newXtoolRequest} {
  255.     [$this xtoolRequestSet] append $newXtoolRequest
  256.  
  257. }
  258.  
  259. method ClDispatcher::removeXtoolRequest {this oldXtoolRequest} {
  260.     [$this xtoolRequestSet] removeValue $oldXtoolRequest
  261. }
  262.  
  263. method ClDispatcher::addAllTool {this newAllTool} {
  264.     [$this allToolSet] append $newAllTool
  265.  
  266. }
  267.  
  268. method ClDispatcher::removeAllTool {this oldAllTool} {
  269.     [$this allToolSet] removeValue $oldAllTool
  270. }
  271.  
  272.