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]
}