home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cayenne Software Inc. 1996
- #
- # File: @(#)command.tcl /main/hindenburg/2
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)command.tcl /main/hindenburg/2 11 Nov 1996 Copyright 1996 Cayenne Software Inc.
-
- # Start user added include file section
- # End user added include file section
-
-
- Class Command : {Object} {
- method destructor
- constructor
- method escape
- method execute
- method interfaceBusy
- method interfaceReady
- method script
- attribute errorStack
- attribute errorTrace
- attribute errorCode
- attribute cursor
- attribute message
- attribute finishScript
- attribute type
- attribute updateState
- attribute workCursor
- attribute _script
- attribute handler
- attribute viewUpdate
- }
-
- global Command::id
- set Command::id 0
-
-
- method Command::destructor {this} {
- # Start destructor user section
-
- if {[lindex [$this updateState] 0] && "[$this viewUpdate]" != ""} {
- catch {[$this viewUpdate] updateView}
- }
- if {[lindex [$this updateState] 1] &&
- [isCommand [$wmttoolObj wmtArea]]} {
- catch {[$wmttoolObj updateWmtArea]}
- }
- if {[$this workCursor]} {
- $this interfaceReady
- }
-
- set type [$this type]
- if {"$type" == "tcl" &&
- [lsearch -exact "[$this script]" "SystemUtilities::fork"] == -1} {
- wmtkmessage ""
- }
-
- if {[string length "[$this errorStack]"] > 0} {
- global errorInfo errorCode
- set errorInfo [$this errorTrace]
- set errorCode [$this errorCode]
- wmtkerror "[$this errorStack]"
- return
- }
-
- if {"$type" != "extern"} {
- set finishScript "[$this finishScript]"
- if {"$finishScript" != ""} {
- eval $finishScript
- if {"$type" == "xtool" || "$type" == "mtool"} {
- $wmttoolObj watchdogBusy 0
- }
- }
- }
-
- # End destructor user section
- }
-
- constructor Command {class this handler} {
- global Command::id
- incr Command::id
- set this [Object::constructor $class $this Command:${Command::id}]
- $this handler $handler
- return $this
- }
-
- method Command::escape {this cmd} {
- if $win95 {
- return $cmd
- }
-
- set sn $cmd
- if {[regsub -all "\[ \t\]>" $sn " @OUT" snn]} {set sn $snn}
- if {[regsub -all "\[ \t\]<" $sn " @IN" snn]} {set sn $snn}
-
- if {"[$this type]" == "extern"} {
- if {[regsub -all {"} $sn {\\"} snn]} {set sn $snn}
- }
- if {[regsub -all {!} $sn {\\!} snn]} {set sn $snn}
- if {[regsub -all {\$} $sn {\\$} snn]} {set sn $snn}
- if {[regsub -all {&} $sn {\\&} snn]} {set sn $snn}
- if {[regsub -all {'} $sn {\\'} snn]} {set sn $snn}
- if {[regsub -all {`} $sn {\\`} snn]} {set sn $snn}
- if {[regsub -all {\(} $sn {\\(} snn]} {set sn $snn}
- if {[regsub -all {\)} $sn {\\)} snn]} {set sn $snn}
- if {[regsub -all {<} $sn {\\<} snn]} {set sn $snn}
- if {[regsub -all {>} $sn {\\>} snn]} {set sn $snn}
- if {[regsub -all {\[} $sn {\\[} snn]} {set sn $snn}
- if {[regsub -all {\]} $sn {\\]} snn]} {set sn $snn}
- if {[regsub -all {\{} $sn {\\\{} snn]} {set sn $snn}
- if {[regsub -all {\}} $sn {\\\}} snn]} {set sn $snn}
-
- if {[regsub -all "@OUT" $sn ">" snn]} {set sn $snn}
- if {[regsub -all "@IN" $sn "<" snn]} {set sn $snn}
- return $sn
- }
-
- method Command::execute {this {tool ""} {dir ""}} {
- wmtkmessage "[$this message]"
- if {[$this workCursor]} {
- $this interfaceBusy
- }
- case [$this type] in {
- {tcl} {
- if [catch {eval [$this script]} msg] {
- if [info exists errorInfo] {
- $this errorTrace $errorInfo
- $this errorCode $errorCode
- }
- $this errorStack $msg
- }
- $this delete
- }
- {extern} {
- SystemUtilities::fork otk watchdog \
- "[get_comm_name]" \
- "[$this escape [$this script]]" \
- "[$this finishScript]"
- $this delete
- }
- {default} {
- if {"[$this finishScript]" != ""} {
- $wmttoolObj watchdogBusy 1
- }
- if {"$dir" == ""} {
- set dir [pwd]
- }
- send -async $tool Exetool::startCommand \
- [list [$this escape [$this script]]] \
- [list $dir] \
- [list [Communicator::getEnv]] \
- [list [Communicator::getM4Env]] \
- [list [get_comm_name]] \
- [list $this]
- }
- }
- }
-
- method Command::interfaceBusy {this} {
- $wmttoolObj busy TRUE
- }
-
- method Command::interfaceReady {this} {
- $wmttoolObj busy FALSE
- }
-
- method Command::script {this args} {
-
- if {$args == ""} {
- return "[$this _script]"
- } else {
- set cmd "[join $args]"
- set ids [$wmttoolObj selectedIdSet]
- set namestypes [$wmttoolObj selectedNameTypeSet]
- # substitute $SELIDS, $SELNAMES, $ARGSELIDS and $ARGSELNAMES
- set index [string first \$ARGSELIDS "$cmd"]
- if {$index != -1} {
- set argsfile [args_file $ids]
- set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
- set index [expr { $index + 10}]
- set cmdAfter [string range "$cmd" $index end]
- set cmd "$cmdBefore $argsfile $cmdAfter"
- }
-
- set index [string first \$ARGSELNAMES "$cmd"]
- if {$index != -1} {
- set argsfile [args_file $namestypes]
- set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
- set index [expr { $index + 12}]
- set cmdAfter [string range "$cmd" $index end]
- set cmd "$cmdBefore $argsfile $cmdAfter"
- }
-
- set index [string first \$SELIDS "$cmd"]
- if {$index != -1} {
- set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
- set index [expr { $index + 7}]
- set cmdAfter [string range "$cmd" $index end]
- set cmd "$cmdBefore $ids $cmdAfter"
- }
-
- set index [string first \$SELNAMES "$cmd"]
- if {$index != -1} {
- set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
- set index [expr { $index + 9}]
- set cmdAfter [string range "$cmd" $index end]
- set cmd "$cmdBefore $namestypes $cmdAfter"
- }
-
- $this _script "$cmd"
- }
- }
-
- # Do not delete this line -- regeneration end marker
-
-