'''Q.''' Is there a way a user can press a "stop"
[button], for example, to stop the running [script] without killing the main
application?

'''A1.''' by mailto:kris.klindworth@carle.com :
You can get much of the effect you want by selectively
redefining key [TCL] [command]s.  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 mailto:m.barth@de.bosch.com :
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 [interp]reter 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.  -PSE''

Also, 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 SIGINT
in [[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
 } SIGINT

This 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.]

'''DL'''

Tcl 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.  --'''ZB'''
----
I'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]} stopProc 
stopProc 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 with 

  if [file exists ./stop] break

so I can break out of a tight loop without inducing event anomalies due to the excessive use of the update command.

----