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 >
Wrap
Text File
|
1996-08-06
|
7KB
|
272 lines
#---------------------------------------------------------------------------
#
# (c) Cadre Technologies Inc. 1996
#
# File: @(#)cldispatch.tcl /main/3
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)cldispatch.tcl /main/3 12 Jun 1996 Copyright 1996 Cadre Technologies Inc.
# Start user added include file section
require platform.tcl
require systemutil.tcl
# End user added include file section
# Definition of Dispatcher class.
# This class handles the startup of exetools and the
# communication between exetools and the dispatcher.
Class ClDispatcher : {Object} {
method destructor
constructor
method addFreeMtool
method removeFreeMtool
method addFreeXtool
method removeFreeXtool
method addMtoolRequest
method removeMtoolRequest
method addXtoolRequest
method removeXtoolRequest
method addAllTool
method removeAllTool
attribute clientCount
attribute id
attribute freeMtoolSet
attribute freeXtoolSet
attribute mtoolRequestSet
attribute xtoolRequestSet
attribute allToolSet
}
global ClDispatcher::dispatcher
set ClDispatcher::dispatcher ""
method ClDispatcher::destructor {this} {
# Start destructor user section
[$this allToolSet] foreach tool {
send -async $tool {${Exetool::exetool} stop}
}
# End destructor user section
}
constructor ClDispatcher {class this name startUpTool} {
set this [Object::constructor $class $this $name]
# Check this before doing a send command
if $win95 {
# should never show up
MainWindow new .main -title Dispatcher
PushButton new .main.push -label exit
}
if {! [isRunning $startUpTool 1]} {
exit
}
$this config \
-freeMtoolSet [List new] \
-freeXtoolSet [List new] \
-mtoolRequestSet [List new] \
-xtoolRequestSet [List new] \
-allToolSet [List new] \
-clientCount 1
set tool [ClDispatcher::exists]
if {$tool != ""} {
# Another dispatcher is running. Register the client with
# that tool, return that one to the client and exit.
send $tool ClDispatcher::registerClient [list $startUpTool]
send -async $startUpTool WmtTool::dispatcherStarted [list $tool]
exit
}
global ClDispatcher::dispatcher
set ClDispatcher::dispatcher $this
set id [get_comm_name]
$this id $id
send -async $startUpTool WmtTool::dispatcherStarted [list $id]
return $this
}
# Check if another dispatcher is running
# for the same host and user.
#
#
proc ClDispatcher::exists {} {
set tools [interps]
set dispatcher [get_comm_name]
foreach tool $tools {
if {("$tool" == "$dispatcher") ||
("[lindex $tool 1]" != "[lindex $dispatcher 1]") ||
("[lindex $tool 2]" != "[lindex $dispatcher 2]") ||
(! [isRunning "$tool"])} continue
if {"[lindex $tool 0]" == "[lindex $dispatcher 0]"} {
return $tool
}
}
return ""
}
proc ClDispatcher::getFreeMtool {requester cmd {dir ""}} {
set this ${ClDispatcher::dispatcher}
set freeList [$this freeMtoolSet]
if [llength [$freeList contents]] {
set list [$this allToolSet]
for {set index 0; set freeIndex -1} {$freeIndex == -1} {incr index 1} {
set tool [$list index $index]
set freeIndex [lsearch -exact [$freeList contents] $tool]
}
$freeList remove $freeIndex
if [isRunning $tool] {
send -async $requester WmtTool::mtoolAvailable \
[list $tool] $cmd [list $dir]
} else {
ClDispatcher::mtoolDied $tool
ClDispatcher::getFreeMtool $requester $cmd $dir
}
} else {
$this addMtoolRequest $requester
SystemUtilities::fork otk mtool "[$this id]" $cmd [list $dir]
}
}
proc ClDispatcher::getFreeXtool {requester cmd {dir ""}} {
set this ${ClDispatcher::dispatcher}
set freeList [$this freeXtoolSet]
if [llength [$freeList contents]] {
set list [$this allToolSet]
for {set index 0; set freeIndex -1} {$freeIndex == -1} {incr index 1} {
set tool [$list index $index]
set freeIndex [lsearch -exact [$freeList contents] $tool]
}
$freeList remove $freeIndex
if [isRunning $tool] {
send -async $requester WmtTool::xtoolAvailable \
[list $tool] $cmd [list $dir]
} else {
ClDispatcher::xtoolDied $tool
ClDispatcher::getFreeXtool $requester $cmd $dir
}
} else {
$this addXtoolRequest $requester
startXTool [$this id] $cmd [list $dir]
}
}
proc ClDispatcher::mtoolStarted {mtool cmd {dir ""}} {
set this ${ClDispatcher::dispatcher}
set list [$this mtoolRequestSet]
set requester [$list index 0]
$list remove 0
send -async $requester WmtTool::mtoolAvailable [list $mtool] $cmd $dir
$this addAllTool $mtool
}
proc ClDispatcher::mtoolUnavailable {mtool} {
${ClDispatcher::dispatcher} removeFreeMtool $mtool
}
proc ClDispatcher::mtoolAvailable {mtool} {
${ClDispatcher::dispatcher} addFreeMtool $mtool
}
proc ClDispatcher::mtoolDied {mtool} {
${ClDispatcher::dispatcher} removeFreeMtool $mtool
${ClDispatcher::dispatcher} removeAllTool $mtool
}
proc ClDispatcher::xtoolStarted {xtool cmd {dir ""}} {
set this ${ClDispatcher::dispatcher}
set list [$this xtoolRequestSet]
set requester [$list index 0]
$list remove 0
send -async $requester WmtTool::xtoolAvailable [list $xtool] $cmd $dir
$this addAllTool $xtool
}
proc ClDispatcher::xtoolUnavailable {xtool} {
${ClDispatcher::dispatcher} removeFreeXtool $xtool
}
proc ClDispatcher::xtoolAvailable {xtool} {
${ClDispatcher::dispatcher} addFreeXtool $xtool
}
proc ClDispatcher::xtoolDied {xtool} {
${ClDispatcher::dispatcher} removeFreeXtool $xtool
${ClDispatcher::dispatcher} removeAllTool $xtool
}
proc ClDispatcher::registerClient {client} {
set this ${ClDispatcher::dispatcher}
$this clientCount [expr {[$this clientCount] + 1}]
}
proc ClDispatcher::unregisterClient {client} {
set this ${ClDispatcher::dispatcher}
set cnt [$this clientCount]
incr cnt -1
if {$cnt == 0} {
$this delete
exit
}
$this clientCount $cnt
}
# Do not delete this line -- regeneration end marker
method ClDispatcher::addFreeMtool {this newFreeMtool} {
[$this freeMtoolSet] append $newFreeMtool
}
method ClDispatcher::removeFreeMtool {this oldFreeMtool} {
[$this freeMtoolSet] removeValue $oldFreeMtool
}
method ClDispatcher::addFreeXtool {this newFreeXtool} {
[$this freeXtoolSet] append $newFreeXtool
}
method ClDispatcher::removeFreeXtool {this oldFreeXtool} {
[$this freeXtoolSet] removeValue $oldFreeXtool
}
method ClDispatcher::addMtoolRequest {this newMtoolRequest} {
[$this mtoolRequestSet] append $newMtoolRequest
}
method ClDispatcher::removeMtoolRequest {this oldMtoolRequest} {
[$this mtoolRequestSet] removeValue $oldMtoolRequest
}
method ClDispatcher::addXtoolRequest {this newXtoolRequest} {
[$this xtoolRequestSet] append $newXtoolRequest
}
method ClDispatcher::removeXtoolRequest {this oldXtoolRequest} {
[$this xtoolRequestSet] removeValue $oldXtoolRequest
}
method ClDispatcher::addAllTool {this newAllTool} {
[$this allToolSet] append $newAllTool
}
method ClDispatcher::removeAllTool {this oldAllTool} {
[$this allToolSet] removeValue $oldAllTool
}