** Description ** Various implementation of a command that is used to periodically invoke a script or command ** Barebones ** [RS]: ====== proc every {ms body} { if 1 $body after $ms [list after idle [info level 0]] } ====== [PYK] 2012-12-04: Alternatively, use a command instead: ====== proc every {ms cmd} { {*}$cmd after $ms [list after idle [info level 0]] } ====== ... or, with a simple cancel option: ====== proc every {ms body} { global every if {$ms == "cancel"} {after cancel $every($body); unset every($body); return} set every($body) [info level 0] eval $body after $ms [info level 0] } ====== and this is a tidied version of the digital clock that started this page: ====== pack [label .clock -textvar time] every 1000 {set ::time [clock format [clock sec] -format %H:%M:%S]} ====== I admit that the minimal ''every'' creates runaway timers that will tick on forever - almost: you can reset all timers with ====== foreach id [after info] {after cancel $id} ====== To limit the number of repetitions, use return: ====== proc every {ms body} { eval $body after $ms [info level 0] } set nmax 3 every 1000 {puts hello; if {[incr ::nmax -1]<=0} return} ====== ---- [RJM]: In the case of a body/script that takes a considerable time fraction of the interval time, the following [every] is more precise, provided the script under repetitive execution will ''normally'' not execute longer than the interval duration: ====== proc every {ms body} {after $ms [info level 0]; eval $body} ====== The after command is set up ''prior'' to the script call. One problem with this approach is that the body can not then "cancel" itself via [return] [FPX]: Note that the latter may not be a good idea if the body (a) may in fact take longer to execute than the interval, and (b) invokes, at some point, the event loop. In that case, you might want to guard against reentrancy. [RJM]: Shouldn't be a serious problem. It will only cause more stack access when any script executes longer than the after interval. It works pretty good for situations where the script has a big execution time standard deviation for each invocation. [AMG]: Reëntrancy? The event loop runs in the same thread as the rest of the script, so the script can't "run on top of itself". It has return to the event loop before the event loop can start it again. Also, a long script/short timeout won't completely starve out other events, because the event loop will give them all their fair turn. A very long-running script will result in poor user interface response times, but it won't completely freeze the program unless the script loops indefinitely. ---- [Ken]: When i ran the code above, it seems it only runs when the event loop is idle. If the event loop is busy with a while procedure, it doesn't run. What is a better alternative? [Lars H]: Yes, while one event is being processed, no additional events are fetched. This is as it is supposed to be. As for better alternatives... The hardliners would tell you to not use a while loop, but instead unroll it into the event loop as well. See [Keep a GUI alive during a long calculation] for more on the subject. [Ken]: As currently i am trying to code a simulator of wireless sensor nodes running under the background, so what i have to do is create for example 10 nodes and run them all under the background under the event loop. Thus allowing my main tcl interpreter to be responsive or running to user requests. And how to get one node to run under an event loop is it to create a 'proc' and run a ' after' command on it? ** See Also ** * [Syncronized timer] ** bgLoop ** ====== ## ******************************************************** ## ## Name: bgLoop ## ## Description: ## Start (a)synchronous looping jobs. Jobs are ended by ## setting ::bg::jobs($name,run) to 0. ## ## Usage: ## start: bgLoop $name $code $delay ## stop: set ::bg::jobs($name,run) 0 ## ## Comment: ## We started seeing mysterious delays in some very complex ## event code, and I modified the older version of bgLoop ## to provide some timing info... what I learned was that ## beyond a certain level of complexity it is better to know ## what is really going on, so SYNCHRONOUS looping is ## quite useful. ## ## What is very nice is that the event loop is not blocked ## for the entire runtime of the multiple scheduled code ## blocks, and the timing diagnostic lets you design around ## long running tasks by modifying the delays so they are ## of by so-many seconds... ## ## Note that the first iteration "returns" for sanity, ## and that you *should* use a custom bgerror handler ## if you are doing this from Tcl like I am (no Tk). ## bgLoop { { name NULL } { code "" } { delay 2 } } { if { ! [ llength [ namespace children :: bg ] ] } { namespace eval bg {} set ::bg::starttime [ clock seconds ] } set now [ clock seconds ] set elapsed [ expr { $now - $::bg::starttime } ] ;## register a new job if it has valid args if { ! [ string equal NULL $name ] && \ [ string length [ join $code ] ] } { set ::bg::jobs($name,run) 1 set ::bg::jobs($name,code) $code set ::bg::jobs($name,delay) $delay puts stderr "Looping process $name started" } if { [ info exists ::bg::after ] && \ [ lsearch [ after info ] $::bg::after ] != -1 } { after cancel $::bg::after } if { [ string equal NULL $name ] } { set dt 0 foreach job [ array names ::bg::jobs *,run ] { set job [ lindex [ split $job , ] 0 ] if { [ string equal NULL $job ] } { continue } if { [ string equal 0 $::bg::jobs($job,run) ] } { foreach item [ array names ::bg::jobs $job,* ] { unset ::bg::jobs($item) } puts stderr "Looping process $job terminated" continue } if { ! ($elapsed % $::bg::jobs($job,delay)) } { set ts [ clock clicks -milliseconds ] eval $::bg::jobs($job,code) set te [ clock clicks -milliseconds ] set td [ expr $te - $ts ] set dt [ expr $dt + $td ] lappend data [ list $job $td ] } } if { $dt > 1000 } { puts stderr "bgLoop runtime per iteration: $dt ms ($data)" } set ::bg::after [ after 1000 bgLoop ] } else { set retval [ eval $::bg::jobs($name,code) ] set ::bg::after [ after 1000 bgLoop ] return $retval } } ====== [DKF]: Here's a version of '''every''' that can be cancelled too: ====== proc every {interval script} { global everyIds if {$interval eq "cancel"} { catch {after cancel $everyIds($script)} return } set everyIds($script) [after $interval [info level 0]] uplevel #0 $script } ====== [NEM] ''30 July 2006'': And here's one that can be cancelled from within the script too (using [break]): ====== proc every {interval script} { global everyIds if {$interval eq "cancel"} { after cancel $everyIds($script) return } set everyIds($script) [after $interval [info level 0]] set rc [catch {uplevel #0 $script} result] if {$rc == [catch break]} { after cancel $everyIds($script) set rc 0 } elseif {$rc == [catch continue]} { # Ignore - just consume the return code set rc 0 } # TODO: Need better handling of errorInfo etc... return -code $rc $result } ====== Which allows the countdown example to be written as: ====== set nmax 3 every 1000 { puts hello if {[incr nmax -1] <= 0} { break } } ====== [RS] 2006-07-31: Hmm yes, but the [simple] [every] allows that too, if you just use [return]: ====== proc every {ms body} {eval $body; after $ms [info level 0]} set ::nmax 3 every 1000 {puts hello; if {[incr ::nmax -1]<=0} return} ====== I prefer not to use implicit global scope, for environment tidyness... :) [NEM] Well, implicit global scope is characteristic of other event callbacks, so it seems like the least surprising option. Likewise, having to use [return] to exit something that isn't a proc seems confusing. I prefer a simple interface to a simple implementation. (Also the simple version has the problem of time drift if you have a long-running script as discussed above). ---- 26-may-2005 ---- [Jeffrey Hobbs] supplies a comparable, but distinct, version of "every", in a post on [http://groups.google.com/groups?selm=37BC45C8.72F9509B%40scriptics.com%|%comp.lang.tcl , 1999-08-19]. ====== # every -- # Cheap rescheduler # every