Updated 2016-09-28 19:26:49 by MHo ▲

Frank Pilhofer: I am currently writing a Tk program that frequently needs to exec external programs. I became annoyed that the GUI becomes unresponsive during exec, especially that there are no updates. For example, if any parts of the window become obscured and un-obscured again (e.g. if you drag another window across it), the GUI is not redrawn. This is ugly, and people get the impression that the application has crashed.

Therefore, I wrote the following tk_exec drop-in replacement for exec. It is supposed to work the same, but it keeps the event loop rolling as it waits for the external program to complete. After completion, it returns the program's stdandard output.

I have not yet tested it extensively. Feel free to edit, update and fix.
  proc tk_exec_fileevent {id} {
    global tk_exec_data
    global tk_exec_cond
    global tk_exec_pipe

    if {[eof $tk_exec_pipe($id)]} {
        fileevent $tk_exec_pipe($id) readable ""
        set tk_exec_cond($id) 1
        return
    }

    append tk_exec_data($id) [read $tk_exec_pipe($id) 1024]
  }

  proc tk_exec {args} {
    global tk_exec_id
    global tk_exec_data
    global tk_exec_cond
    global tk_exec_pipe
    global tcl_platform
    global env

    if {![info exists tk_exec_id]} {
        set tk_exec_id 0
    } else {
        incr tk_exec_id
    }

    set keepnewline 0

    for {set i 0} {$i < [llength $args]} {incr i} {
        set arg [lindex $args $i]
        switch -glob -- $arg {
            -keepnewline {
                set keepnewline 1
            }
            -- {
                incr i
                break
            }
            -* {
                error "unknown option: $arg"
            }
            * {
                break
            }
        }
    }

    if {$i > 0} {
        set args [lrange $args $i end]
    }

    if {$tcl_platform(platform) == "windows" && \
        [info exists env(COMSPEC)]} {
        set args [linsert $args 0 $env(COMSPEC) "/c"]
    }

    set pipe [open "|$args" r]

    set tk_exec_pipe($tk_exec_id) $pipe
    set tk_exec_data($tk_exec_id) ""
    set tk_exec_cond($tk_exec_id) 0

    fconfigure $pipe -blocking 0
    fileevent $pipe readable "tk_exec_fileevent $tk_exec_id"

    vwait tk_exec_cond($tk_exec_id)

    if {$keepnewline} {
        set data $tk_exec_data($tk_exec_id)
    } else {
        set data [string trimright $tk_exec_data($tk_exec_id) \n]
    }

    unset tk_exec_pipe($tk_exec_id)
    unset tk_exec_data($tk_exec_id)
    unset tk_exec_cond($tk_exec_id)

    if {[catch {close $pipe} err]} {
        error "pipe error: $err"
    }

    return $data
  }

Some issues:

  • A "background" exec (with &) is not handled yet.
  • The case that stdout is redirected is not handled yet.

[Nice work, Frank.]

The proposed tk_exec routine suffers from thread safety problems, in particular if it is used to launch two processes and they exit in reverse order (the 2nd terminates first) you get an error. The problem is that after the vwait function some variables are unset using a global index (tk_exec_id) which has been in the mean time incremented by the 2nd process start. The simple trick is to copy the global tk_exec_id in a local "id" variable and use this one. The patch file follows
  # --- patch begin ---
  --- tk_exec.tcl   2006-11-03 19:12:04.000000000 +0100
  +++ tk_exec_old.tcl 2006-11-03 19:18:34.000000000 +0100
  @@ -64,20 +64,21 @@
       set tk_exec_data($tk_exec_id) ""
       set tk_exec_cond($tk_exec_id) 0
  
  +    set id  $tk_exec_id
       fconfigure $pipe -blocking 0
  -    fileevent $pipe readable "tk_exec_fileevent $tk_exec_id"
  +    fileevent $pipe readable "tk_exec_fileevent $id"
  
  -    vwait tk_exec_cond($tk_exec_id)
  +    vwait tk_exec_cond($id)
  
       if {$keepnewline} {
  -       set data $tk_exec_data($tk_exec_id)
  +       set data $tk_exec_data($id)
       } else {
  -       set data [string trimright $tk_exec_data($tk_exec_id) \n]
  +       set data [string trimright $tk_exec_data($id) \n]
       }
  
  -    unset tk_exec_pipe($tk_exec_id)
  -    unset tk_exec_data($tk_exec_id)
  -    unset tk_exec_cond($tk_exec_id)
  +    unset tk_exec_pipe($id)
  +    unset tk_exec_data($id)
  +    unset tk_exec_cond($id)
  
       if {[catch {close $pipe} err]} {
          error "pipe error: $err"
  # --- patch end ---

Thank you for this work ! Stefan ([email protected])

Dave Snyderman points out that Brent's book [1] includes an ExecLog that does much of the same.

The BLT extension has a command bgexec which is similar. Example code from the BLT docs (slightly adapted):
 proc widgetwrite { data } {
    # Put your output-handling code here, e.g.
    .t insert end $data
 }
 global myStatus
 blt::bgexec myStatus -onoutput widgetwrite du -s $dir

Tk will continue to handle events while the external command is running; whenever the command writes to its stdout, the output is delivered by a call to the proc named by "-onoutput": no need to wait for the command to complete.

FPX: I just made a change to add "command /c" before the command to be executed if the platform is windows. I got weird results (hangs) in Windows otherwise. - RS: Note however that command.com is the weaker DOS shell - on Win NT/2K you have cmd.exe (but command.com is still there); the default shell can be found in ::env(COMSPEC). - FPX: okay, so I've replaced "command" with env(COMSPEC) above.

DGP You ought to take one more step and make use of auto_execok.

[PFV]: In order to get the exit status of the exec'd command, the channel needs to be configured back to blocking mode before closing the pipe, like:
  +    fconfigure $pipe -blocking 1

       if {[catch {close $pipe} err]} {
          error "pipe error: $err"

See also:

Category Command