home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / cldispatch.tcl < prev    next >
Text File  |  1996-08-06  |  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. proc ClDispatcher::exists {} {
  104.     set tools [interps]
  105.     set dispatcher [get_comm_name]
  106.     foreach tool $tools {
  107.     if {("$tool" == "$dispatcher") ||
  108.         ("[lindex $tool 1]" != "[lindex $dispatcher 1]") ||
  109.         ("[lindex $tool 2]" != "[lindex $dispatcher 2]") ||
  110.         (! [isRunning "$tool"])} continue
  111.     if {"[lindex $tool 0]" == "[lindex $dispatcher 0]"} {
  112.         return $tool
  113.     }
  114.     }
  115.     return ""
  116. }
  117.  
  118. proc ClDispatcher::getFreeMtool {requester cmd {dir ""}} {
  119.     set this ${ClDispatcher::dispatcher}
  120.     set freeList [$this freeMtoolSet]
  121.     if [llength [$freeList contents]] {
  122.     set list [$this allToolSet]
  123.     for {set index 0; set freeIndex -1} {$freeIndex == -1} {incr index 1} {
  124.         set tool [$list index $index]
  125.         set freeIndex [lsearch -exact [$freeList contents] $tool]
  126.     }
  127.     $freeList remove $freeIndex
  128.     if [isRunning $tool] {
  129.         send -async $requester WmtTool::mtoolAvailable \
  130.         [list $tool] $cmd [list $dir]
  131.     } else {
  132.             ClDispatcher::mtoolDied $tool
  133.         ClDispatcher::getFreeMtool $requester $cmd $dir
  134.     }
  135.     } else {
  136.     $this addMtoolRequest $requester
  137.     SystemUtilities::fork otk mtool "[$this id]" $cmd [list $dir]
  138.     }
  139. }
  140.  
  141. proc ClDispatcher::getFreeXtool {requester cmd {dir ""}} {
  142.     set this ${ClDispatcher::dispatcher}
  143.     set freeList [$this freeXtoolSet]
  144.     if [llength [$freeList contents]] {
  145.     set list [$this allToolSet]
  146.     for {set index 0; set freeIndex -1} {$freeIndex == -1} {incr index 1} {
  147.         set tool [$list index $index]
  148.         set freeIndex [lsearch -exact [$freeList contents] $tool]
  149.     }
  150.     $freeList remove $freeIndex
  151.     if [isRunning $tool] {
  152.         send -async $requester WmtTool::xtoolAvailable \
  153.         [list $tool] $cmd [list $dir]
  154.     } else {
  155.             ClDispatcher::xtoolDied $tool
  156.         ClDispatcher::getFreeXtool $requester $cmd $dir
  157.     }
  158.     } else {
  159.     $this addXtoolRequest $requester
  160.     startXTool [$this id] $cmd [list $dir]
  161.     }
  162. }
  163.  
  164. proc ClDispatcher::mtoolStarted {mtool cmd {dir ""}} {
  165.     set this ${ClDispatcher::dispatcher}
  166.     set list [$this mtoolRequestSet]
  167.     set requester [$list index 0]
  168.     $list remove 0
  169.     send -async $requester WmtTool::mtoolAvailable [list $mtool] $cmd $dir
  170.     $this addAllTool $mtool
  171. }
  172.  
  173. proc ClDispatcher::mtoolUnavailable {mtool} {
  174.     ${ClDispatcher::dispatcher} removeFreeMtool $mtool
  175. }
  176.  
  177. proc ClDispatcher::mtoolAvailable {mtool} {
  178.     ${ClDispatcher::dispatcher} addFreeMtool $mtool
  179. }
  180.  
  181. proc ClDispatcher::mtoolDied {mtool} {
  182.     ${ClDispatcher::dispatcher} removeFreeMtool $mtool
  183.     ${ClDispatcher::dispatcher} removeAllTool $mtool
  184. }
  185.  
  186. proc ClDispatcher::xtoolStarted {xtool cmd {dir ""}} {
  187.     set this ${ClDispatcher::dispatcher}
  188.     set list [$this xtoolRequestSet]
  189.     set requester [$list index 0]
  190.     $list remove 0
  191.     send -async $requester WmtTool::xtoolAvailable [list $xtool] $cmd $dir
  192.     $this addAllTool $xtool
  193. }
  194.  
  195. proc ClDispatcher::xtoolUnavailable {xtool} {
  196.     ${ClDispatcher::dispatcher} removeFreeXtool $xtool
  197. }
  198.  
  199. proc ClDispatcher::xtoolAvailable {xtool} {
  200.     ${ClDispatcher::dispatcher} addFreeXtool $xtool
  201. }
  202.  
  203. proc ClDispatcher::xtoolDied {xtool} {
  204.     ${ClDispatcher::dispatcher} removeFreeXtool $xtool
  205.     ${ClDispatcher::dispatcher} removeAllTool $xtool
  206. }
  207.  
  208. proc ClDispatcher::registerClient {client} {
  209.     set this ${ClDispatcher::dispatcher}
  210.     $this clientCount [expr {[$this clientCount] + 1}]
  211. }
  212.  
  213. proc ClDispatcher::unregisterClient {client} {
  214.     set this ${ClDispatcher::dispatcher}
  215.     set cnt [$this clientCount]
  216.     incr cnt -1
  217.     if {$cnt == 0} {
  218.     $this delete
  219.     exit
  220.     }
  221.     $this clientCount $cnt
  222. }
  223.  
  224. # Do not delete this line -- regeneration end marker
  225.  
  226. method ClDispatcher::addFreeMtool {this newFreeMtool} {
  227.     [$this freeMtoolSet] append $newFreeMtool
  228.  
  229. }
  230.  
  231. method ClDispatcher::removeFreeMtool {this oldFreeMtool} {
  232.     [$this freeMtoolSet] removeValue $oldFreeMtool
  233. }
  234.  
  235. method ClDispatcher::addFreeXtool {this newFreeXtool} {
  236.     [$this freeXtoolSet] append $newFreeXtool
  237.  
  238. }
  239.  
  240. method ClDispatcher::removeFreeXtool {this oldFreeXtool} {
  241.     [$this freeXtoolSet] removeValue $oldFreeXtool
  242. }
  243.  
  244. method ClDispatcher::addMtoolRequest {this newMtoolRequest} {
  245.     [$this mtoolRequestSet] append $newMtoolRequest
  246.  
  247. }
  248.  
  249. method ClDispatcher::removeMtoolRequest {this oldMtoolRequest} {
  250.     [$this mtoolRequestSet] removeValue $oldMtoolRequest
  251. }
  252.  
  253. method ClDispatcher::addXtoolRequest {this newXtoolRequest} {
  254.     [$this xtoolRequestSet] append $newXtoolRequest
  255.  
  256. }
  257.  
  258. method ClDispatcher::removeXtoolRequest {this oldXtoolRequest} {
  259.     [$this xtoolRequestSet] removeValue $oldXtoolRequest
  260. }
  261.  
  262. method ClDispatcher::addAllTool {this newAllTool} {
  263.     [$this allToolSet] append $newAllTool
  264.  
  265. }
  266.  
  267. method ClDispatcher::removeAllTool {this oldAllTool} {
  268.     [$this allToolSet] removeValue $oldAllTool
  269. }
  270.  
  271.