software/tcl/bgloops.tcl

   1 #
   2 # Package bgloops - provides control structures which run in background.
   3 # using after idle
   4 #
   5
   6 namespace eval bgloops {
   7   variable serial 0
   8 }
   9
  10 proc bgwhile {expr body {delay idle}} {
  11     incr ::bgloops::serial
  12     ;proc $::bgloops::serial {} [list if $expr  "[list uplevel $body]\n\
  13               after $delay $bgloops::serial" else [list rename\
  14               $::bgloops::serial {}]]
  15     after $delay $::bgloops::serial
  16 }
  17
  18 proc bgfor {init test incr body {delay idle}} {
  19    incr ::bgloops::serial
  20    uplevel #0 $init
  21    ;proc $::bgloops::serial {} [list if $test "[list uplevel $body]\n\
  22    $incr\nafter $delay $bgloops::serial" else [list rename\
  23      $::bgloops::serial {}]]
  24    after $delay $::bgloops::serial
  25 }
  26
  27 proc tailrecurse args {
  28   after idle [concat [list [info level 1]] $args]
  29   return -code return
  30 }
  31
  32 package provide Bgloops 1.0