Posted to tcl by hypnotoad at Thu Jun 09 20:03:24 GMT 2016view raw

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