Posted to tcl by hypnotoad at Thu Jun 09 19:29:44 GMT 2016view pretty
proc ::tool::main {} { package require cron 1.2 variable event_loops variable last_event if {[info exists ::tool::main(1)]} { if {$::tool::main(1)} { set last_event -1 set ::tool::wake_up 1 update if {$last_event>0} return puts "Avoiding second call into ::tool::main" return } } ### # Have the cron::wake procedure wake up an idle loop instead # of it's normal run commands in the background ### proc ::cron::wake {} { set ::tool::wake_up 1 } # Signal for all other MAIN loops to terminate for {set x 0} {$x < $event_loops} {incr x} { set ::tool::main($x) 0 } set ::tool::wake_up -1 update set this [incr event_loops] set ::tool::main($this) 1 set ::tool::wake_up 0 while {$::tool::main($this)} { set panic [after 120000 {puts "Warning: Tool event loop has not responded in 2 minutes"}] incr ::tool::loops(all) if {[info command ::CRON] eq {}} { coroutine ::CRON ::cron::runTasksCoro } # Cap cron delays at 1 minute set cron_delay [::CRON] if {$cron_delay > 60} { set cron_delay 60 } set tool_running [::tool::do_events] if {$cron_delay==0 || $tool_running>0} { incr ::tool::loops(active) update } else { incr ::tool::loops(idle) set ::tool::wake_up 0 after [expr {$cron_delay*1000}] {set ::tool::wake_up 1} vwait ::tool::wake_up } after cancel $panic if {$::tool::wake_up < 0} { break } } puts [list EXITING TOOL EVENT LOOP #$this] }