** Description **

Various implementation of a command that is used to periodically invoke a script or command

** Barebones **

[RS]: Funny how different styles can be used. My ''every'' looks like this:

======
proc every {ms body} {
    if 1 $body
    after $ms [list after idle [info level 0]]
}
======

[PYK] 2012-12-04: Alternatively, supply a command 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} 
======

[RS] 2005-05-27: Alternatively, one could put the counter into the script itself, and still use the one-liner [every]:

======
proc every {ms body} {
    eval $body; after $ms [info level 0]
}
set nmax 3
every 1000 {puts hello; if {[incr ::nmax -1]<=0} return}
======

The ability for ''body'' to prevent repetition with [return] is another reason
for putting its evaluation in front :^)

[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 main event is idle. If the main event 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]




======
 ## ******************************************************** 
 ##
 ## 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
     }
 }
======

----
[Jeffrey Hobbs] supplies a comparable, but distinct, version of "every", in his comp.lang.tcl posting [http://groups.google.com/groups?selm=37BC45C8.72F9509B%40scriptics.com].
----

Here's a scheduler that lets you schedule regular events and stop them whenever you like, using a similar scheme to [[after]]/[[after cancel]].  ''- DKF''
======
## ****************************************************************
## Name:
##     every
## Description:
##     Schedules a script for being regularly executed, returning
##     a token that allows the scheduling to be halted at some
##     future point.
## Usage:
##     every ms script...
##     every cancel token
##     every cancel script...
## Notes:
##     The script is executed at the global level, and any errors
##     generated by the script will NOT cause a cessation of future
##     schedulings.  Thus, any script that always causes an error
##     will cause many user-interface problems when used with a
##     short delay.
##     While differently scheduled scripts do not need to be
##     distinct from each other, it is not determined which one
##     will be cancelled if you use the cancelling form with the
##     script as opposed to the token.
## Example:
##     set foo [every 500 {puts [clock format [clock seconds]]}]
##     every 10000 puts Howdy!
##     # ...
##     after cancel $foo
##     after cancel puts Howdy!
## ****************************************************************
proc every {option args} {
    global everyPriv every:UID
    if {[string equal -length [string length $option] $option cancel]} {
        set id {}
        if {[llength $args] == 1 && [string match every#* [lindex $args 0]]} {
            set id [lindex $args 0]
        } else {
            set script [eval [list concat] $args]
            # Yuck, a linear search.  A reverse hash would be faster...
            foreach {key value} [array get everyPriv] {
                if {[string equal $script [lindex $value 1]]} {
                    set id $key
                    break
                }
            }
        }
        if {[string length $id]} {
            after cancel [lindex $everyPriv($id) 2]
            unset everyPriv($id)
        }
    } else {
        set id [format "every#%d" [incr every:UID]]
        set script [eval [list concat] $args]
        set delay $option
        set aid [after $delay [list every:afterHandler $id]]
        set everyPriv($id) [list $delay $script $aid]
        return $id
    }
}
## Internal stuff - I could do this with a namespace, I suppose...
array set everyPriv {}
set every:UID 0
proc every:afterHandler {id} {
    global everyPriv
    foreach {delay script oldaid} $everyPriv($id) {}
    set aid [after $delay [info level 0]]
    set everyPriv($id) [list $delay $script $aid]
    uplevel #0 $script
}
======
''(I have this feeling that my definition of production-quality code is not the same as that of other people.)''
---- 

[Josua Dietze] <digidietze at t-online.de> contributed this idea
on news:comp.lang.tcl :
======
 proc TimerFunction {state {rate {}}} {
 global after_id
    if { $state == "start" } {
        sendVal "send_status"
        set after_id [after $rate TimerFunction start $rate]
    } elseif { $state == "stop" } {
        after cancel $after_id
    }
 }

 TimerFunction start 2000
 TimerFunction stop
======
Just make sure you start and stop exactly once ...

----

[kruzalex] An alternative to the stuff mentioned above:
======
proc every {interval args} {
    global everyPriv every:UID
    if {[string equal -length [string length $interval] $interval cancel]} {
    set id {}
    if {[llength $args] == 1 && [string match every#* [lindex $args 0]]} {
        set id [lindex $args 0]
    } 
    if {[string length $id]} {
        after cancel [lindex $everyPriv($id) 2]
        unset everyPriv($id)
        return
     }
    }
    set id [format "every#%d" [incr every:UID]]
    set script [eval [list concat] $args]
    foreach {key value} [array get everyPriv] {
        if {[string equal $script [lindex $value 1]]} {
            set id $key
            set time [lindex $everyPriv($id) 0]
            break
        } 
    }
    if {![info exists everyPriv($id)]} {
        set everyPriv($id) [concat $interval [list $script] [after $interval [info level 0]]]
    } else {
        uplevel #0 $script
        set everyPriv($id) [concat $time [list $script] [after $interval [info level 0]]]
    }
    return $id
}

array set everyPriv {}
set every:UID 0

#Example
set foo [every 1000 {puts foo}]
set foo1 [every 2000 {puts foo1}]
after 3000 [list every cancel $foo]
vwait forever
======






** With Cancel **

[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

----
[XO] 2008-12-03: See also http://code.activestate.com/recipes/68393/%|%Recipe 68393: Repeat procedure every X seconds %|%  
----
======
proc every {ms body} {
    set t [string range [time $body] 0 end-27]
    after [expr {$ms-$t/1000}] [info level 0]  
}
======
----
[http://wiki.tcl.tk/25434%|%rjmcmahon%|%] Here's a full blown version of every that covers most cases. Calls to it are:
    :   '''every''' ''seconds'' ?''script script ...''?
   ** returns an everyid
    :   '''every''' ''integer'' '''-milliseconds''' ?''script script ...''?
   ** returns an everyid
    :   '''every cancel''' ''everyid''
    :   '''every cancel all'''
    :   '''every info'''
   ** returns all everyids

======
proc every {args} {
    global _everyids  _everyid 

    if {![llength $args]} {
        if {[info exists _everyids]} {
            parray _everyids
        }
        return
    }

    set interval [lindex $args 0]
    if {$interval == "info"} {
        return [array names _everyids]
    }
    #
    # See if arg1 is a -milliseconds option
    # 
    set arg1 [lindex $args 1]
    if {$arg1 == "-milliseconds"} {
        set script [lrange $args 2 end]
    } else {
        #
        #  In this case a numeric arg1 is given in seconds
        #  so convert to an integer number of ms.
        #
        if {$interval != "cancel" && $interval != "idle"} { 
            set interval [expr {round($interval * 1000)}]
        }
        set script [lrange $args 1 end]
    }

    #
    #  Process any cancel requests. 
    #  Options are
    #  o  every cancel all
    #  o  every cancel <everyid>
    #
    if {$interval eq "cancel"} {
        if {![info exists _everyids]} {
            return
        }
        if {$script eq "all"} {   
            set idlist [array names _everyids]
            foreach id $idlist {   
                if {$_everyids($id) != "RUNNING"} {
                    after cancel $_everyids($id)
                    unset _everyids($id)
                } else {
                    set _everyids($id) "CANCELPENDING"
                }
            }
        } else {
            set index $script
             if {[info exists _everyids($index)]} {
                # Cancel now if the script is not running
                # otherwise signal the underlying _every not to reschedule
                if {$_everyids($index) != "RUNNING"} {
                    after cancel $_everyids($index)
                    unset _everyids($index)
                } else {
                    set _everyids($index) "CANCELPENDING"
                }        
            }
        }
        return
    }
    if {[info exists _everyid]} {
        incr _everyid
    } else {
        set _everyid 100
    }

    #
    #  Now that user command processing is done, call the 
    #  underlying every routine to start the script on 
    #  its periodic (per interval) and return a unique everyid.
    #
    _every $interval $script "every#$_everyid"
    return "every#$_everyid"
}

proc _every {interval script id} {
    global _everyids 

    #
    #  Run the script and measure the time taken to run
    # 
    set starttime [clock clicks -milliseconds]
    set _everyids($id) "RUNNING"
    set rc [catch {uplevel #0 eval $script} result]
    set finishtime [clock clicks -milliseconds]
    
    #
    #  Detect and process any catch codes from the script
    #
    #  Note: The script returning a break catch code is 
    #  used to indicate a silent stop of the rescheduling 
    # 
    if {$rc == [catch error]} {
        error "$result $script"
        return 
    } elseif {$rc == [catch break]} {
        if {[info exists _everyids($id)]} {
            unset _everyids($id) 
        }
        return
    } elseif {$rc == [catch continue]} {
        # Ignore - just consume the return code
        set rc 0
    }
    
    #
    #  Adjust the reschedule time per the actual runtime
    #  Provide a minimum of 30 ms for a yield 
    #
    if {$interval != "idle"} {
        set runtime [expr {$finishtime - $starttime}]
        set adj_interval [expr {$interval - $runtime}]
        if {$adj_interval < 0} {
            puts "$script runtime ($runtime ms) exceeded reschedule interval ($interval ms)" 
        }
        #
        #  Set a minimum of 30 ms to reschedule
        #
        if {$adj_interval < 30} {
            set adj_interval 30
        }
    } else {
        set adj_interval "idle"
    }
    
    #
    #  Reschedule next iteration unless there is a cancel pending.
    #
    #  Note:  The rescheduling of the script is done after
    #  calling it. This can be swapped but is a bit more complex,
    #  particularly when execution time > interval.
    #
    if {$_everyids($id) != "CANCELPENDING"} {
        set _everyids($id) [after $adj_interval [list _every $interval $script $id]]
    } else {
        unset _everyids($id)
    }
}
======

<<categories>>Command