]> wagner.pp.ru Git - sites/home_page.git/blob - software/tcl/bgloops.tcl
grandpa picture
[sites/home_page.git] / 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