home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1997 November
/
PCWorld_1997-11_cd.bin
/
software
/
programy
/
komix
/
DATA.Z
/
wmttool.tcl
< prev
next >
Wrap
Text File
|
1996-11-21
|
14KB
|
520 lines
#---------------------------------------------------------------------------
#
# (c) Cayenne Software Inc. 1996
#
# File: @(#)wmttool.tcl /main/hindenburg/9
# Author: <generated>
# Description:
#---------------------------------------------------------------------------
# SccsId = @(#)wmttool.tcl /main/hindenburg/9 21 Nov 1996 Copyright 1996 Cayenne Software Inc.
# Start user added include file section
require command.tcl
require classmaker.tcl
require wmt_util.tcl
# End user added include file section
require "communicat.tcl"
# Definition of class WmtTool which is a base class
# for tools that are able to start exetools.
Class WmtTool : {Communicator} {
method destructor
constructor
method watchdogBusy
method ready
method selectedIdSet
method selectedNameTypeSet
method startDispatcher
method startCommand
method startCommandWithOptions
method startM4Command
method startDocbatch
method startExetool
method toolBarPresent
method contextAreaPresent
method messageAreaPresent
method addToolBar
method addContextArea
method addMessageArea
method updateToolBar
method updateWmtArea
method setToolBarPresence
method saveToolBarPresence
method setContextAreaPresence
method saveContextAreaPresence
method setMessageAreaPresence
method saveMessageAreaPresence
method setWindowGeometry
method saveWindowGeometry
method addActiveCmd
method removeActiveCmd
method addMtoolPending
method removeMtoolPending
method addXtoolPending
method removeXtoolPending
attribute dispatcher
attribute _watchdogBusy
attribute exitButton
attribute exitStatusList
attribute caller
attribute notSavedM4Vars
attribute _selectedIdSet
attribute _selectedNameTypeSet
attribute activeCmdSet
attribute mtoolPendingSet
attribute xtoolPendingSet
}
method WmtTool::destructor {this} {
# Start destructor user section
set dispatcher [$this dispatcher]
if {$dispatcher != ""} {
send -async $dispatcher \
ClDispatcher::unregisterClient [list [get_comm_name]]
}
set notSaved [$this notSavedM4Vars]
m4_var foreach m4var {
foreach varSpec $notSaved {
if [string match $varSpec $m4var] {
m4_var saveStatus $m4var 0
}
}
}
m4_var save
# End destructor user section
$this Communicator::destructor
}
constructor WmtTool {class this name} {
set this [Communicator::constructor $class $this $name]
$this config \
-activeCmdSet [List new] \
-mtoolPendingSet [List new] \
-xtoolPendingSet [List new] \
-_watchdogBusy 0 \
-notSavedM4Vars {
M4_corproles__*
M4_projroles__*
M4_levelpath*
}
global wmttoolObj
set wmttoolObj $this
$this startDispatcher
return $this
}
proc WmtTool::dispatcherStarted {dispatcher} {
$wmttoolObj dispatcher $dispatcher
}
proc WmtTool::externCmdFailed {cmd obj} {
foreach exitStatus [$wmttoolObj exitStatusList] {
if $exitStatus {
wmtkmessage "Executing '$cmd' for '$obj' failed"
break
}
}
}
proc WmtTool::mtoolAvailable {mtool cmd {dir ""}} {
set this $wmttoolObj
set list [$this mtoolPendingSet]
$list removeValue $cmd
$this addActiveCmd $cmd
$cmd execute $mtool $dir
}
proc WmtTool::xtoolAvailable {xtool cmd {dir ""}} {
set this $wmttoolObj
set list [$this xtoolPendingSet]
$list removeValue $cmd
$this addActiveCmd $cmd
$cmd execute $xtool $dir
}
# This callback function is called when an exetool
# has been started.
#
proc WmtTool::exetoolStarted {clientId} {
wmtkmessage ""
}
# This callback function is called when an exetool
# is finished with the execution of command(s).
#
proc WmtTool::exetoolFinished {clientId exitStatusList} {
set this $wmttoolObj
$this exitStatusList $exitStatusList
$this removeActiveCmd $clientId
$clientId delete
}
method WmtTool::watchdogBusy {this {flag ""}} {
if {"$flag" != ""} {
set watchdogBusy [$this _watchdogBusy]
if $flag {
incr watchdogBusy 1
} else {
incr watchdogBusy -1
}
$this _watchdogBusy $watchdogBusy
if {"[$this exitButton]" != ""} {
if {$watchdogBusy > 0} {
[$this exitButton] sensitive 0
wmtkmessage ""
} else {
[$this exitButton] sensitive 1
}
}
}
return [$this _watchdogBusy]
}
method WmtTool::ready {this} {
set caller [$this caller]
if {"$caller" != "" && [isRunning $caller]} {
send -async $caller {wmtkmessage ""}
}
}
method WmtTool::selectedIdSet {this} {
set selectedIdSet [$this _selectedIdSet]
if {"$selectedIdSet" == "undefined"} {
set selectedIdSet ""
foreach obj [[$this flatView] selectedSet] {
lappend selectedIdSet [[$obj browsUiObj] getInfo Identity]
}
$this _selectedIdSet $selectedIdSet
}
return $selectedIdSet
}
method WmtTool::selectedNameTypeSet {this} {
set selectedNameTypeSet [$this _selectedNameTypeSet]
if {"$selectedNameTypeSet" == "undefined"} {
set selectedNameTypeSet ""
foreach obj [[$this flatView] selectedSet] {
set browsUiObj [$obj browsUiObj]
if [$browsUiObj isA ExternalFileVersion] {
lappend selectedNameTypeSet "[$browsUiObj getInfo Path]"
} elseif [$browsUiObj isA DocSection] {
lappend selectedNameTypeSet "[$browsUiObj getInfo Path]"
} else {
lappend selectedNameTypeSet \
"[$browsUiObj getInfo Name].[$browsUiObj getInfo Type]"
}
}
$this _selectedNameTypeSet $selectedNameTypeSet
}
return $selectedNameTypeSet
}
method WmtTool::startDispatcher {this} {
# Start dispatcher if not running. We really need to lock the
# interpreter registry some how, since this is full of raise conditions.
wmtkmessage "Starting dispatcher..."
set disp ""
set dispInterp [lrange [lreplace [get_comm_name] 0 0 dispatcher] 0 2]
foreach tool [interps] {
if {$dispInterp == [lrange $tool 0 2] && [isRunning $tool]} {
set disp $tool
send -async $tool \
ClDispatcher::registerClient [list [get_comm_name]]
break
}
}
if {$disp == ""} {
SystemUtilities::fork otk dispatcher "[get_comm_name]"
}
$this dispatcher $disp
wmtkmessage "Done"
}
method WmtTool::startCommand {this type cmd endCmd msg upd busy {dir ""}} {
case $type in {
{mtool xtool} {
set dispatcher [$this dispatcher]
if {"$dispatcher" == ""} {
wmtkerror "Dispatcher can not be started or is not running yet"
return
}
if {! [isRunning $dispatcher]} {
wmtkerror "Dispatcher is not running: starting new one"
$this startDispatcher
return
}
}
}
set command [Command new $this \
-type $type \
-script $cmd \
-finishScript $endCmd \
-message $msg \
-updateState $upd \
-viewUpdate $this \
-workCursor $busy]
case $type in {
mtool {
wmtkmessage "Starting Monitoring Window..."
$this addMtoolPending $command
send -async [$this dispatcher] \
ClDispatcher::getFreeMtool [list [get_comm_name]] $command $dir
}
xtool {
wmtkmessage "Starting Execution Window..."
$this addXtoolPending $command
send -async [$this dispatcher] \
ClDispatcher::getFreeXtool [list [get_comm_name]] $command $dir
}
default {
$command execute $dir
}
}
}
method WmtTool::startCommandWithOptions {this type cmd endCmd msg upd busy {dir ""}} {
# Ask options first before starting command
set box $this.startCommandWithOptions
ClassMaker::extend EntryDialog OptionsEntryDialog \
{type cmdBefore cmdAfter endCmd msg upd busy dir}
# find the $OPTIONS string to determine the place of the options
set index [string first \$OPTIONS "$cmd"]
set cmdBefore "$cmd"
set cmdAfter ""
if {$index != -1} {
set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
set index [expr { $index + 9}]
set cmdAfter [string range "$cmd" $index end]
}
OptionsEntryDialog new $box \
-modal yes \
-title "Options for '$cmdBefore <options> $cmdAfter'" \
-type $type \
-cmdBefore $cmdBefore \
-cmdAfter $cmdAfter \
-endCmd $endCmd \
-msg $msg \
-upd $upd \
-busy $busy \
-dir $dir \
-cancelPressed {%this delete} \
-okPressed {
$wmttoolObj startCommand "[%this type]" \
"[%this cmdBefore] [%this entry] [%this cmdAfter]" "[%this endCmd]"\
"[%this msg]" "[%this upd]" "[%this busy]" "[%this dir]"
%this delete
}
$box delHelpButton
$box popUp
}
method WmtTool::startM4Command {this m4Cmd m4CmdArgs endCmd obj {dir ""}} {
set command [m4_var get M4_[lindex $m4Cmd 0] -context [lindex $m4Cmd 1]]
set wincommand \
[m4_var get M4_win_[lindex $m4Cmd 0] -context [lindex $m4Cmd 1]]
if {"$wincommand" == "" || (! $wincommand)} {
set kind xtool
} else {
set kind extern
set endCmd \
"WmtTool::externCmdFailed [list $command] [list $obj] ; $endCmd"
}
if {$win95 && "$kind" == "extern"} {
set script "$command $m4CmdArgs"
} else {
set script "$command \"$m4CmdArgs\""
}
$this startCommand $kind \
"$script" "$endCmd" "Starting '$command' for '$obj'" \
{0 0} 0 $dir
}
method WmtTool::startDocbatch {this type args endCmd upd busy {dir ""}} {
set exe [m4_path_name bin otprint$EXE_EXT]
set cmd [m4_path_name tcl docbatch.tcl]
set script "[quoteIf $exe] [quoteIf $cmd] -- $args"
set msg "Starting docbatch"
$this startCommand $type $script $endCmd $msg $upd $busy $dir
}
# Start an exetool (xtool or mtool).
#
method WmtTool::startExetool {this kind {dir ""}} {
if {! [$this isA MainWindow]} {
wmtkerror "Cannot start an exetool"
return
}
set box [format "%s.%s%s" "$this" "$kind" "Options"]
if {! [isCommand $box]} {
require "browseentr.tcl"
ClassMaker::extend BrowseEntryDlg ExetoolEntryDialog {kind dir}
case "$kind" in {
mtool {
set title "Monitoring Window Command(s)"
}
xtool {
set title "Execution Window Command(s)"
}
}
ExetoolEntryDialog new $box \
-modal yes \
-title $title \
-kind $kind \
-message "Command(s):" \
-okPressed {
$wmttoolObj startCommand [%this kind] \
"[%this entry]" "" "Starting '[%this entry]'..." \
{0 0} 0 [%this dir]
}
}
$box dir $dir
$box popUp
}
method WmtTool::toolBarPresent {this show} {
if {$show} {
$this addToolBar
$this updateToolBar
} else {
[$this toolBar] delete
}
}
method WmtTool::contextAreaPresent {this show} {
if {$show} {
$this addContextArea
[$this wmtArea] index 0
$this updateWmtArea
} else {
[$this wmtArea] delete
$this wmtArea ""
}
}
method WmtTool::messageAreaPresent {this show} {
if {$show} {
$this addMessageArea
} else {
[$this messageArea] delete
}
}
method WmtTool::addToolBar {this} {
ToolBar new $this.toolBar -justification FILLED
}
method WmtTool::addContextArea {this} {
# empty
}
method WmtTool::addMessageArea {this} {
MessageArea new $this.messageArea
}
method WmtTool::updateToolBar {this} {
# empty
}
method WmtTool::updateWmtArea {this} {
# empty
}
method WmtTool::setToolBarPresence {this context} {
if [m4_var get M4_toolbar -context $context] {
$this addToolBar
} else {
[$this menuBar].view.menu.toolbar state 0
}
}
method WmtTool::saveToolBarPresence {this context} {
set barPresent [expr {[$this toolBar] != ""}]
if {$barPresent != [m4_var get M4_toolbar -context $context]} {
m4_var set M4_toolbar $barPresent -context $context
}
}
method WmtTool::setContextAreaPresence {this context} {
if [m4_var get M4_contextarea -context $context] {
$this addContextArea
} else {
[$this menuBar].view.menu.contextarea state 0
}
}
method WmtTool::saveContextAreaPresence {this context} {
set areaPresent [expr {[$this wmtArea] != ""}]
if {$areaPresent != [m4_var get M4_contextarea -context $context]} {
m4_var set M4_contextarea $areaPresent -context $context
}
}
method WmtTool::setMessageAreaPresence {this context} {
if [m4_var get M4_messagearea -context $context] {
$this addMessageArea
} else {
[$this menuBar].view.menu.messagearea state 0
}
}
method WmtTool::saveMessageAreaPresence {this context} {
set areaPresent [expr {[$this messageArea] != ""}]
if {$areaPresent != [m4_var get M4_messagearea -context $context]} {
m4_var set M4_messagearea $areaPresent -context $context
}
}
method WmtTool::setWindowGeometry {this context} {
.main geometry [m4_var get M4_geometry -context $context]
}
method WmtTool::saveWindowGeometry {this context} {
set geom [.main geometry]
if {$geom != [m4_var get M4_geometry -context $context]} {
m4_var set M4_geometry $geom -context $context
}
}
# Do not delete this line -- regeneration end marker
method WmtTool::addActiveCmd {this newActiveCmd} {
[$this activeCmdSet] append $newActiveCmd
}
method WmtTool::removeActiveCmd {this oldActiveCmd} {
[$this activeCmdSet] removeValue $oldActiveCmd
}
method WmtTool::addMtoolPending {this newMtoolPending} {
[$this mtoolPendingSet] append $newMtoolPending
}
method WmtTool::removeMtoolPending {this oldMtoolPending} {
[$this mtoolPendingSet] removeValue $oldMtoolPending
}
method WmtTool::addXtoolPending {this newXtoolPending} {
[$this xtoolPendingSet] append $newXtoolPending
}
method WmtTool::removeXtoolPending {this oldXtoolPending} {
[$this xtoolPendingSet] removeValue $oldXtoolPending
}