Posted to tcl by hypnotoad at Thu Jun 09 19:29:44 GMT 2016view raw

  1. proc ::tool::main {} {
  2. package require cron 1.2
  3. variable event_loops
  4. variable last_event
  5. if {[info exists ::tool::main(1)]} {
  6. if {$::tool::main(1)} {
  7. set last_event -1
  8. set ::tool::wake_up 1
  9. update
  10. if {$last_event>0} return
  11. puts "Avoiding second call into ::tool::main"
  12. return
  13. }
  14. }
  15. ###
  16. # Have the cron::wake procedure wake up an idle loop instead
  17. # of it's normal run commands in the background
  18. ###
  19. proc ::cron::wake {} {
  20. set ::tool::wake_up 1
  21. }
  22. # Signal for all other MAIN loops to terminate
  23. for {set x 0} {$x < $event_loops} {incr x} {
  24. set ::tool::main($x) 0
  25. }
  26. set ::tool::wake_up -1
  27. update
  28. set this [incr event_loops]
  29. set ::tool::main($this) 1
  30. set ::tool::wake_up 0
  31.  
  32. while {$::tool::main($this)} {
  33. set panic [after 120000 {puts "Warning: Tool event loop has not responded in 2 minutes"}]
  34. incr ::tool::loops(all)
  35. if {[info command ::CRON] eq {}} {
  36. coroutine ::CRON ::cron::runTasksCoro
  37. }
  38. # Cap cron delays at 1 minute
  39. set cron_delay [::CRON]
  40. if {$cron_delay > 60} {
  41. set cron_delay 60
  42. }
  43. set tool_running [::tool::do_events]
  44. if {$cron_delay==0 || $tool_running>0} {
  45. incr ::tool::loops(active)
  46. update
  47. } else {
  48. incr ::tool::loops(idle)
  49. set ::tool::wake_up 0
  50. after [expr {$cron_delay*1000}] {set ::tool::wake_up 1}
  51. vwait ::tool::wake_up
  52. }
  53. after cancel $panic
  54. if {$::tool::wake_up < 0} {
  55. break
  56. }
  57. }
  58. puts [list EXITING TOOL EVENT LOOP #$this]
  59. }