Version 9 of after PT

Updated 2019-02-10 12:07:14 by pooryorick

after ms

after ms ?script script script ...?

after cancel id

after cancel script script script ...

after idle ?script script script ...?

after info ?id?


after ms
Ms tem de ser um numero com um tempo dado em milesimos. O comando espera por MS milesimos e depois retorna. Enquanto o comando espera a aplicação não responde a eventos.

Richard Suchenwirth - O comando after serve várias funções:

  • after nn -- operação suspensa por nn milesimos
  • after nn conteudo -- regista o conteudo para ser executado depois de nn milesimos
  • after cancel id -- desregista um conteudo pelo numero de identificação
  • ...

Vê a documentação oficial em http://www.purl.org/tcl/home/man/tcl8.4/TclCmd/after.htm .

Acções repetidas sao aplicações típicas, ex. este pequeno timer do Bag of Tk algorithms:

Clock display on label:

 proc clock:set var {
   global $var
   set $var [clock format [clock seconds] -format %H:%M:%S]
   after 800 [list clock:set $var]
 }

 pack [label .l -textvariable myclock]
 clock:set myclock          ;# chamar uma vez, continuar a tiquetar ;-) RS

Isto nao é uma recursão, a proxima instancia do clock:set irá ser iniciada bem depois do currente retornar, e não irá bem fundo no nivel stack.

O comando será reiniciado a cada 800 milesimos (neste caso), com um id diferente em cada vez. Para manter o id currente para poder ser cancelado, o Josua Dietze <digidietze at t-online.de> contribuiu com esta ideia em 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

Apenas assegura que inicia e para exactamente uma vez ...


Vê também An analog clock in Tk que é composto pelo after. KBK (15 November 2000) Countdown program tem uma discussão melhor no que está a acontecer.


 ## ******************************************************** 
 ##
 ## Nome: bgLoop 
 ##
 ## Descrição:
 ## Inicia loops de trabalho (a)sincronizados.  Trabalhos são acabados pela
 ## definição ::bg::jobs($name,run) to 0.
 ##
 ## Uso:
 ##        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
     }
 }

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 [namespace code [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.)


Jeffrey Hobbs supplies a comparable, but distinct, version of "every", in his comp.lang.tcl posting [L1 ].


Funny how different styles can be used. My every looks like this:

 proc every {ms body} {
     eval $body
     after $ms [list every $ms $body]
 } ;# RS

Come to think, the list building is still redundant, so for a one-liner:

 proc every {ms body} {eval $body; after $ms [namespace code [info level 0]]} ;# RS

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} 

Here's a sugaring for after where you specify absolute time, like for a scheduler:

 proc at {time args} {
   if {[llength $args]==1} {set args [lindex $args 0]}
   set dt [expr {([clock scan $time]-[clock seconds])*1000}]
   after $dt $args
 } ;# RS
 at 9:31 puts Hello
 at 9:32 {puts "Hello again!"}

If you need something to schedule, this little alert packages details from tk_dialog away, and may reappear after 5 minutes:

 proc alert {time text} {
  if [tk_dialog .[clock clicks] "Alert at $time" $text info 0 OK Re-Alert] {
    after 300000 [list alert $time $text]
  }
 }
 at 9:55 alert 10:00 "Meeting in 5 minutes"

['Xplain bout how "after 0 $script" is valuable, and also safer than "after idle $script", 'cause an "after idle" body can't "after idle".]


FW: If when executing eg this:

 proc again {} {
   puts "Hello."
   after 1000 again
 }

... If I change the system time backwards an hour in Windows as the script is running, I stop receiving "hellos". I'm guessing the event loop schedules "after" events to occur at a certain fixed time, dependent on the system clock (so of course setting the time backwards will postpone scheduled "after" events), but WHY? Why not just use an internal clicker rather than the system clock? And more importantly (for my project) is there a way to avoid this behavior?


For an example of how to cache idle commands, see: idle


When using after with tcl, you need to call vwait to start the event loop.

Chang LI

This program used array to arrange the intervals of events.

 proc print {} {
        global ary state
        puts "$state $ary($state)"
 }

 proc timer {} {
        global ary state num

        print
        after $ary($state) {
                set state [expr ($state+1)%$num]
                timer
        }
 }

 array set ary {0 100 1 200 2 300 3 400 4 500}

 set num [array size ary]
 set state 0
 timer

Question (14Jul2003)

How to stop execution of a procedure from within another procedure?

FW: Try setting up an after task that starts immediately, running the procedure. When you first invoke your procedure do something like this:

  set aid [after 0 {myProc}]

Then to stop the execution:

  after cancel $aid

On Oct. 7, 2003, aricb wrote on c.l.t.:

After has a "synchronous" mode and an "asynchronous" mode. The synchronous mode is in the form [after $milliseconds]. In this case Tcl does nothing for $milliseconds. Then it processes the next line in your script.

The asynchronous mode is [after $milliseconds $script], where Tcl schedules $script to execute (via the event loop) after $milliseconds has passed. Tcl then returns to whatever else it was doing. In this case, after returns an id which you can use in conjunction with [after cancel $id] or [after info $id].

Here are a couple of procs to demonstrate the difference:

   proc sync {} {
       after 1000
       puts "message 1"
       puts "message 2"
   }

   proc async {} {
       after 1000 [list puts "message 1"]
       puts "message 2"
   }