home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / command.tcl < prev    next >
Text File  |  1996-11-19  |  6KB  |  219 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)command.tcl    /main/titanic/2
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)command.tcl    /main/titanic/2   19 Nov 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class Command : {Object} {
  16.     method destructor
  17.     constructor
  18.     method escape
  19.     method execute
  20.     method interfaceBusy
  21.     method interfaceReady
  22.     method script
  23.     attribute errorStack
  24.     attribute errorTrace
  25.     attribute errorCode
  26.     attribute cursor
  27.     attribute message
  28.     attribute finishScript
  29.     attribute type
  30.     attribute updateState
  31.     attribute workCursor
  32.     attribute _script
  33.     attribute handler
  34.     attribute viewUpdate
  35. }
  36.  
  37. global Command::id
  38. set Command::id 0
  39.  
  40.  
  41. method Command::destructor {this} {
  42.     # Start destructor user section
  43.  
  44.     if {[lindex [$this updateState] 0] && "[$this viewUpdate]" != ""} {
  45.         catch {[$this viewUpdate] updateView}
  46.     }
  47.     if {[lindex [$this updateState] 1] &&
  48.         [isCommand [$wmttoolObj wmtArea]]} {
  49.         catch {[$wmttoolObj updateWmtArea]}
  50.     }
  51.     if {[$this workCursor]} {
  52.         $this interfaceReady
  53.     }
  54.  
  55.     set type [$this type]
  56.     if {"$type" == "tcl" &&
  57.         [lsearch -exact "[$this script]" "SystemUtilities::fork"] == -1} {
  58.         wmtkmessage ""
  59.     }
  60.  
  61.     if {[string length "[$this errorStack]"] > 0} {
  62.         global errorInfo errorCode
  63.         set errorInfo [$this errorTrace]
  64.         set errorCode [$this errorCode]
  65.         wmtkerror "[$this errorStack]"
  66.         return
  67.     }
  68.  
  69.     if {"$type" != "extern"} {
  70.         set finishScript "[$this finishScript]"
  71.         if {"$finishScript" != ""} {
  72.         eval $finishScript
  73.         if {"$type" == "xtool" || "$type" == "mtool"} {
  74.             $wmttoolObj watchdogBusy 0
  75.         }
  76.         }
  77.     }
  78.  
  79.     # End destructor user section
  80. }
  81.  
  82. constructor Command {class this handler} {
  83.     global Command::id
  84.     incr Command::id
  85.     set this [Object::constructor $class $this Command:${Command::id}]
  86.     $this handler $handler
  87.     return $this
  88. }
  89.  
  90. method Command::escape {this cmd} {
  91.     if $win95 {
  92.     return $cmd
  93.     }
  94.  
  95.     set sn $cmd
  96.     if {[regsub -all "\[ \t\]>" $sn " @OUT" snn]} {set sn $snn}
  97.     if {[regsub -all "\[ \t\]<" $sn " @IN"  snn]} {set sn $snn}
  98.  
  99.     if {"[$this type]" == "extern"} {
  100.     if {[regsub -all {"}  $sn {\\"}  snn]} {set sn $snn}
  101.     }
  102.     if {[regsub -all {!}  $sn {\\!}  snn]} {set sn $snn}
  103.     if {[regsub -all {\$} $sn {\\$}  snn]} {set sn $snn}
  104.     if {[regsub -all {&}  $sn {\\&}  snn]} {set sn $snn}
  105.     if {[regsub -all {'}  $sn {\\'}  snn]} {set sn $snn}
  106.     if {[regsub -all {`}  $sn {\\`}  snn]} {set sn $snn}
  107.     if {[regsub -all {\(} $sn {\\(}  snn]} {set sn $snn}
  108.     if {[regsub -all {\)} $sn {\\)}  snn]} {set sn $snn}
  109.     if {[regsub -all {<}  $sn {\\<}  snn]} {set sn $snn}
  110.     if {[regsub -all {>}  $sn {\\>}  snn]} {set sn $snn}
  111.     if {[regsub -all {\[} $sn {\\[}  snn]} {set sn $snn}
  112.     if {[regsub -all {\]} $sn {\\]}  snn]} {set sn $snn}
  113.     if {[regsub -all {\{} $sn {\\\{} snn]} {set sn $snn}
  114.     if {[regsub -all {\}} $sn {\\\}} snn]} {set sn $snn}
  115.  
  116.     if {[regsub -all "@OUT" $sn ">" snn]} {set sn $snn}
  117.     if {[regsub -all "@IN"  $sn "<" snn]} {set sn $snn}
  118.     return $sn
  119. }
  120.  
  121. method Command::execute {this {tool ""} {dir ""}} {
  122.     wmtkmessage "[$this message]"
  123.     if {[$this workCursor]} {
  124.     $this interfaceBusy
  125.     }
  126.     case [$this type] in {
  127.     {tcl} {
  128.         if [catch {eval [$this script]} msg] {
  129.         if [info exists errorInfo] {
  130.             $this errorTrace $errorInfo
  131.             $this errorCode $errorCode
  132.         }
  133.         $this errorStack $msg
  134.         }
  135.         $this delete
  136.     }
  137.     {extern} {
  138.         SystemUtilities::fork otk watchdog \
  139.         "[get_comm_name]" \
  140.         "[$this escape [$this script]]" \
  141.         "[$this finishScript]"
  142.         $this delete
  143.     }
  144.     {default} {
  145.         if {"[$this finishScript]" != ""} {
  146.         $wmttoolObj watchdogBusy 1
  147.         }
  148.         if {"$dir" == ""} {
  149.         set dir [pwd]
  150.         }
  151.         send -async $tool Exetool::startCommand \
  152.         [list [$this escape [$this script]]] \
  153.         [list $dir] \
  154.         [list [Communicator::getEnv]] \
  155.         [list [Communicator::getM4Env]] \
  156.         [list [get_comm_name]] \
  157.         [list $this]
  158.     }
  159.     }
  160. }
  161.  
  162. method Command::interfaceBusy {this} {
  163.     $wmttoolObj busy TRUE
  164. }
  165.  
  166. method Command::interfaceReady {this} {
  167.     $wmttoolObj busy FALSE
  168. }
  169.  
  170. method Command::script {this args} {
  171.  
  172.     if {$args == ""} {
  173.         return "[$this _script]"
  174.     } else {
  175.         set cmd "[join $args]"
  176.         set ids [$wmttoolObj selectedIdSet]
  177.         set namestypes [$wmttoolObj selectedNameTypeSet]
  178.         # substitute $SELIDS, $SELNAMES, $ARGSELIDS and $ARGSELNAMES
  179.         set index [string first \$ARGSELIDS "$cmd"]
  180.         if {$index != -1} {
  181.             set argsfile [args_file $ids]
  182.             set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
  183.             set index [expr { $index + 10}]
  184.             set cmdAfter [string range "$cmd" $index end]
  185.             set cmd "$cmdBefore $argsfile $cmdAfter"
  186.         }
  187.  
  188.         set index [string first \$ARGSELNAMES "$cmd"]
  189.         if {$index != -1} {
  190.             set argsfile [args_file $namestypes]
  191.             set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
  192.             set index [expr { $index + 12}]
  193.             set cmdAfter [string range "$cmd" $index end]
  194.             set cmd "$cmdBefore $argsfile $cmdAfter"
  195.         }
  196.  
  197.         set index [string first \$SELIDS "$cmd"]
  198.         if {$index != -1} {
  199.             set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
  200.             set index [expr { $index + 7}]
  201.             set cmdAfter [string range "$cmd" $index end]
  202.             set cmd "$cmdBefore $ids $cmdAfter"
  203.         }
  204.         
  205.         set index [string first \$SELNAMES "$cmd"]
  206.         if {$index != -1} {
  207.             set cmdBefore [string range "$cmd" 0 [expr {$index -1}]]
  208.             set index [expr { $index + 9}]
  209.             set cmdAfter [string range "$cmd" $index end]
  210.             set cmd "$cmdBefore $namestypes $cmdAfter"
  211.         }
  212.  
  213.         $this _script "$cmd"
  214.     }
  215. }
  216.  
  217. # Do not delete this line -- regeneration end marker
  218.  
  219.