home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1997 November
/
PCWorld_1997-11_cd.bin
/
software
/
programy
/
komix
/
DATA.Z
/
exetool.tcl
< prev
next >
Wrap
Text File
|
1996-09-02
|
4KB
|
170 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1996
#
# File: @(#)exetool.tcl /main/hindenburg/3
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)exetool.tcl /main/hindenburg/3 2 Sep 1996 Copyright 1996 Cayenne Software Inc.
# Start user added include file section
# End user added include file section
require "communicat.tcl"
# Definition of class Exetool which is a base class
# for the Mtool and Xtool. It contains functions to
# copy the environment and to set/get the command-line.
Class Exetool : {Communicator} {
method destructor
constructor
method notifyStarted
method notifyFinished
method handleReusableChanged
method start
method stop
method updateTitle
# Registration string of the calling tool.
#
attribute caller
attribute dispatcher
attribute cmdLine
attribute clientId
attribute exitStatusList
}
global Exetool::exetool
set Exetool::exetool ""
method Exetool::destructor {this} {
# Start destructor user section
# End destructor user section
$this Communicator::destructor
}
constructor Exetool {class this name dispatcher} {
set this [Communicator::constructor $class $this $name]
$this dispatcher $dispatcher
global Exetool::exetool
set Exetool::exetool $this
return $this
}
proc Exetool::startCommand {script dir env m4env caller clientId} {
set this ${Exetool::exetool}
$this config -cmdLine $script -caller $caller -clientId $clientId
cd $dir
Communicator::setEnv $env
Communicator::setM4Env $m4env
$this start
}
# Get the first command of a command-line.
# replace backslashes by an unlikely string at start
# put them back on return
proc Exetool::firstCmd {cmdLine} {
set unlikely _@_UnLiKeLy_@_
regsub -all {\\} $cmdLine $unlikely cmd
regsub -all (\ +)([SystemUtilities::cmdSeparator]\ *) \
"$cmd" "[SystemUtilities::cmdSeparator]" cmd
set cmd [string trimleft "$cmd" [SystemUtilities::cmdSeparator]]
set separator [string first "[SystemUtilities::cmdSeparator]" "$cmd"]
if {$separator > 0} {
set cmd [string range "$cmd" 0 [incr separator -1]]
set postfix " ..."
} else {
set postfix ""
}
set cmd "[path_name file [lindex $cmd 0]]$postfix"
regsub -all $unlikely $cmd {\\} cmd
return "$cmd"
}
# Notify caller that start is called.
#
method Exetool::notifyStarted {this} {
if [isRunning [$this caller]] {
send -async [$this caller] WmtTool::exetoolStarted [$this clientId]
}
}
# Notify caller that command(s) are ready.
#
method Exetool::notifyFinished {this} {
if {"[$this clientId]" == ""} {
return
}
if [isRunning [$this caller]] {
send -async [$this caller] WmtTool::exetoolFinished \
[$this clientId] [list [$this exitStatusList]]
}
$this clientId ""
if {[$this reusable] && [isRunning [$this dispatcher]]} {
send -async [$this dispatcher] \
ClDispatcher::[$this toolName]Available [list [get_comm_name]]
}
}
method Exetool::handleReusableChanged {this} {
if {! [isRunning [$this dispatcher]]} {
return
}
if {[$this reusable]} {
send -async [$this dispatcher] \
ClDispatcher::[$this toolName]Available [list [get_comm_name]]
} else {
send -async [$this dispatcher] \
ClDispatcher::[$this toolName]Unavailable [list [get_comm_name]]
}
}
# Base function for exetools to start executing host command(s).
#
method Exetool::start {this} {
$this updateTitle
$this notifyStarted
$this exitStatusList ""
$this execute
}
# Base function for exetools to exit the tool.
#
method Exetool::stop {this} {
catch {
send [$this dispatcher] \
ClDispatcher::[$this toolName]Died [list [get_comm_name]]
}
$this Communicator::stop
}
method Exetool::updateTitle {this} {
set title [$this title]
set hyphen [string first "-" $title]
if {$hyphen < 0} {
append title " -"
} else {
set title [string range $title 0 $hyphen]
}
set iconTitle [Exetool::firstCmd [$this cmdLine]]
append title " $iconTitle"
$this config \
-title $title \
-iconTitle $iconTitle
}
# Do not delete this line -- regeneration end marker