source: trunk/gui/scripts/exec.tcl @ 168

Last change on this file since 168 was 168, checked in by mmc, 16 years ago
  • Fixed the license terms to comply with the official open source license from Purdue's OTC office.
  • Fixed the scroller to handle scrollbars properly. They weren't always popping up when needed. Sometimes you had to scroll a little first. Better now.
  • Fixed the DeviceEditor? to pack its internal widgets better, so images within a DeviceViewer1D structure can change size and will show up properly.
  • Fixed the analyzer to take down the progress bar properly when there's an error during execution.
  • Fixed the Rappture::exec command to initialize execctl properly, in case there's an error during execution.
File size: 4.1 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: exec - simple way to exec with streaming output
3#
4#  This utility makes it easy to exec another tool and get streaming
5#  output from stdout and stderr.  Any stderr messages are specially
6#  encoded with the =RAPPTURE-ERROR=> tag, so they show up in red
7#  in the execution output.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2005  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require BLT
16
17namespace eval Rappture { # forward declaration }
18
19# ----------------------------------------------------------------------
20# USAGE: exec <arg> <arg>...
21#
22# This utility acts like the standard Tcl "exec" command, but it also
23# streams stdout and stderr messages while the command is executing,
24# instead of waiting till the end.  Any error messages are prefixed
25# with the special =RAPPTURE-ERROR=> tag, so they are recognized as
26# errors within Rappture.
27# ----------------------------------------------------------------------
28proc Rappture::exec {args} {
29    variable execout
30    variable execctl
31
32    set execout(output) ""
33    set execout(channel) ""
34    set execout(extra) ""
35    set execctl ""
36
37    set status [catch {eval blt::bgexec ::Rappture::execctl \
38        -keepnewline yes \
39        -onoutput {{::Rappture::_exec_out stdout}} \
40        -onerror {{::Rappture::_exec_out stderr}} \
41        $args} result]
42
43    # add any extra stuff pending from the last stdout/stderr change
44    append execout(output) $execout(extra)
45
46    if {$status != 0} {
47        if {[regexp {^KILLED} $execctl] && [llength $execctl] == 4} {
48            set reason [lindex $execctl end]
49            set result "job killed: $reason"
50        }
51        error $result
52    }
53    return $execout(output)
54}
55
56# ----------------------------------------------------------------------
57# USAGE: _exec_out <channel> <message>
58#
59# Called automatically whenever output comes in from the Rappture::exec
60# utility.  Streams the output to stdout and adds it to the "execout"
61# variable, so it can be returned as one large string at the end of
62# the exec.
63# ----------------------------------------------------------------------
64proc Rappture::_exec_out {channel message} {
65    variable execout
66
67    #
68    # If this message is being written to the stderr channel, then
69    # add the =RAPPTURE-ERROR=> prefix to each line.
70    #
71    if {$channel == "stderr"} {
72        set newmesg ""
73        foreach line [split $message \n] {
74            append newmesg "=RAPPTURE-ERROR=>$line\n"
75        }
76        set message $newmesg
77    }
78
79    #
80    # If this message is coming in on the same channel as the
81    # last, then fine, add it on.  But if it's coming in on a
82    # different channel, we must make sure that we're at a good
83    # breakpoint.  If there's not a line break at the end of the
84    # current output, then add the extra stuff onto a buffer
85    # that we will merge in later once we get to a good point.
86    #
87    if {$execout(channel) == ""} {
88        set execout(channel) $channel
89    }
90
91    set ready [expr {[string length $execout(output)] == 0
92        || [string index $execout(output) end] == "\n"}]
93
94    if {$channel != $execout(channel)} {
95        if {$ready} {
96            # changing channels...
97            if {[string length $execout(extra)] > 0} {
98                # any extra stuff on this new channel? put it out now
99                puts -nonewline $execout(extra)
100                append execout(output) $execout(extra)
101                set execout(extra) ""
102            }
103            puts -nonewline $message
104            append execout(output) $message
105            set execout(channel) $channel
106        } else {
107            # not ready to change channels -- keep this for later
108            append execout(extra) $message
109        }
110    } else {
111        # no need to change channels -- keep printing
112        puts -nonewline $message
113        append execout(output) $message
114    }
115}
Note: See TracBrowser for help on using the repository browser.