: You can get much of the effect you want by selectively redefining key TCL commands. You could, for instance, have the cancel button set a "cancelled" global. Then, you can define a cancelled function which checks for the existence of this global and calls "error" if it is exists. Finally, you can redefine commands like while so that they will insert a call to the cancelled command at the top of each loop. It might look something like this...
proc cancelled {} {
global cancelled
# give the user a chance to hit the cancel button
update
if [info exists cancelled] {
error "Script Cancelled by User"
}
}
rename while _while
proc while {condition body} {
uplevel [list _while $condition "cancelled;$body"]
}If you redefine the proc command and the loop commands then you will get pretty good coverage. You might also want use the after command to set a time limit on the execution. Something like... set timeLimit 1000
set timerId [after $timeLimit {set timedOut 1}]Then you would have the cancelled function check this variable as well. Just be sure that you run "after cancel $timerId" and unset the cancelled and timedOut variables when you return from the users scripts.A2. by Michael Barth: The solution I have implemented is simple: create a new process with the user script. Additionally you can redirect the standard output of the "user process" to a text widget. # tcl code not tested:
button .interrupt -command {close $FID}
pack .interrupt
set FID [open |userscript r]
fileevent readable $FID writeToTextWidget(From posts in news:comp.lang.tcl, slightly adapted by RS. Note however that frequent updates make long runs last even longer ;-)A3. by Tim Wilson mailto:tdw_news@my-deja.com: The solution I have tried is to run the 'meat' code in a slave interpreter and the user interface in the master interpreter. When the user wants to interrupt, the UI simply deletes the slave interpreter.I find that this works for simple-ish examples, but causes core dumps when applied to large projects. (I tried Tcl 8.2.3 and TclPro 1.4.)Thinks: Combine A1 with subinterpreters (use the hiding/alias mechanism to provide non-overrideable overrides) and use [clock seconds] to determine when to time out. Like that it is impossible for anyone to stop you from getting control back properly (especially if you override [catch] to prevent the timeout error from being caught in the subinterp.Hopefully, someone will expand the above brain-dump into some real code! :^) DKF
Not real code, but some places to start: freeMem already evaluates Tcl code in a child process.Not real code?!?!?! Lordy-Lordy... at least the example runs! If you want it interruptible just use a trace variable instead of a vwait. -PSEAlso, one could build (for Unix) a C function extension to Tcl which sets up a SIGALRM and a signal handler. This would be rather hard on the process involved (it would pretty much instantly kill it, or make it so unstable it segfaults soon anyway), so it would have to be combined with something like freeMem to work.Lars H (much later): Segfaulting? On what kind of shaky system? FWIW, I've had the following TclX command
signal -restart error SIGINTin [the equivalent of a .tclshrc ] for months now, without noticing any unstability. It has however permitted me to interrupt several infinite loops without having to kill the entire application. Changing it from SIGINT to SIGALRM should be trivial.
Here is some real code that lets you interrupt a loop using ^C.
trap -code {
error unwound -nostack
} SIGINTThis is using Expect's signal handling.Basically, the way it works is that the -code flag lets whatever control structure (return, continue, error, etc) in the signal handler have its normal affect on whatever piece of code is running.This ability to force the code via a signal handler has been supported in the Tcl core (requires no core changes) for many years although I'm not aware of any other extension that has ever made use of it. [ CL adds that TclX also is signal-savvy.]DLTcl code isn't really executed by a signal handler--the signal's existence is stored in a flag, then the application resumes whatever it was doing immediately. The Tcl interpreter main loop simply checks for asynchronous signals often. This allows an async signal to interrupt pure Tcl code--a Tcl and C mixture would be interrupted only during the Tcl parts. Probably close enough for most people. --ZBI'm interested in a similar question: how can an interpreter to limit the maximum run time of a slave interpreter. For this it would be good to have something in the Tcl core similar to the idea of "ticks" on LambdaMOO, only the 'tick' unit would be whatever increments cmdCount. Ideally, once [info cmdcount] reaches too high a value, any further attempt to execute a Tcl command would raise an error, which eventually forces the interpreter to stop (because the interpreter would be unable to execute any catch{} statements). Finally, when the interpreter itself exits with an error, the parent interpreter (which has a different cmdCount variable, obviously) can clean up.DKF: The only thing to watch out for is making sure that an empty-bodied loop increments the cmdcount as well, or your solution would fail whenever presented with:
while {1} {}If you do this, you need to hide catch in your slave interpreter and replace it with an alias that only lets catches work if they are not due to the raising of a tick-limit induced error. (The global errorCode variable is probably the best way to detect what kind of error happened; all too often it is shamefully ignored by the majority of scripts, and yet it is far easier for scripts to handle it than the errorInfo variable or the message string itself.)ZB: Hmmm...one quick hack to make the loops work would be to put an extra increment in Tcl_EvalObjEx. OTOH one could just find all the looping constructs (foreach, for, while) and modify them.Does anyone have real code that would break if suddenly "foreach x {a b c d e f g} {}" incremented [info cmdcount] by 8 instead of 1?One could also modify 'catch' so that if there is a tick quota, and it is exceeded, then the 'catch' returns the error directly instead of TCL_OK and a result code.I suppose it might be worthwhile for a master interpreter to be able to create a special kind of alias that gets invoked when the tick count is exceeded, e.g. to grab some variables out of the slave, or to increase the slave's tick quota.DKF: It's a bit more complex than that, since you also need to modify the bytecode emitted by the compiler. I suspect that nobody is writing code that depends on the exact behaviour of [info cmdcount] though, since it is one of the things that gets changed when you rewrite commands; the output of that subcommand is just an "interesting statistic" at the moment...GMW: So this is a really old topic -- ca Jan 2000! -- but apparently this deficiency still bugs people! Here's a coded up solution following A2 above. It works under ActiveState TCL using both wish and tclsh. The caveats: starting up the child process is slow, and the only way to communicate with the child process is serial text-based I/O, e.g. no globals between processes. On the other hand, one could just pass straight TCL code between processes for eval. Hope this is useful to somebody at this late date....Put the following in one file:
set FID {}
# Uses both the widget shell root window and the console.
# No apologies whatsoever for the meager UI fundamentals...
proc testabort {} {
global FID
button .start -command { start } -text Start
button .interrupt -command { close $FID; init } -text Abort
button .done -command { done } -text Done
pack .start .interrupt .done
text .output -width 40 -height 4
pack .output
init
}
proc init {} {
global FID
set rc [ catch {
set FID [ open "|tclsh" r+ ]
puts "FID = $FID"
fconfigure $FID -blocking 0 -buffering none
fileevent $FID readable { .output insert end [ read $FID ]; .output see "end linestart" }
} err ]
if { $rc } { puts $err }
}
proc start {} {
global FID
puts $FID "source testcode.tcl"
}
proc done {} {
global FID
close $FID
destroy .start .interrupt .done .output
}Make the next file, testcode.tcl, whatever you'd like, but for example:
# The catch block traps errors from being reported, which occurs when
# an abort occurs and the puts attempts a write to the broken pipe.
set rc [ catch {
set i 0
while {$i < 50000} {
puts $i
incr i
}
} err ]Also, make sure your current working directory is the one that contains both files. The rest I'm sure you can figure out.::G in JP [ gwelch ( ) computer org ] (2004.07.09)US See also DoS.Another way, which does not need an update in the loop, was proposed by Kroc in the Tcl chatroom:
while 1 {
if [file exists ./stop] break
# do the action here...
}By using a break inside the loop, you can use this for other kinds of loops, like for or foreach too. MS commented: Note that you may want better control: if {[file exists ./stop]} stopProcstopProc may then do whatever, and finally return either TCL_OK (as you were), TCL_CONTINUE (skip the rest, go to the next loop iter), TCL_BREAK (abort the loop) or whatever.30-07-2004 SRIV In the overloaded "which" example near the top of this page, I substitute the update command withif [file exists ./stop] breakso I can break out of a tight loop without inducing event anomalies due to the excessive use of the update command. This technique has the ability to break out of a while 1 {} loop. The creation of the stop file needs to be done from an external application, as the looped-up tcl app isn't capable of responding to events, hence the need for this technique.
