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
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"
}
?* {
# the glob should be on *, but the wiki reformats
# that as a bullet
break
}
}
}
if {$i > 0} {
set args [lrange $args $i end]
}
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:
[Nice work, Frank.]