Posted to tcl by aspect at Thu Aug 14 14:40:01 GMT 2014view raw

  1. #
  2. package require Tk
  3. wm withdraw .
  4.  
  5. oo::class create Coobj {
  6. constructor args {
  7. toplevel .win
  8. pack [button .win.b -text "Start doing stuff!" -command [list [self] dostuff]]
  9. }
  10.  
  11. method dostuff {} {
  12.  
  13. # this plumbing can be trivially hidden away:
  14. if {[info coroutine] eq ""} {
  15. if {[info commands [self namespace]::dostuff] ne ""} {
  16. # coroutine is already running - bring it to the foreground
  17. tailcall dostuff flash
  18. } else {
  19. # restart this method as a coroutine
  20. tailcall coroutine [self namespace]::dostuff [self] dostuff
  21. }
  22. }
  23.  
  24. # method body runs in a coroutine:
  25. toplevel .transient
  26. wm transient .transient .win
  27. wm protocol .transient WM_DELETE_WINDOW [list [info coroutine] close]
  28. pack [button .transient.b -text "Finish it!" -command [list [info coroutine] dismiss]]
  29. while {1} {
  30. switch [yield] {
  31. "dismiss" {
  32. break
  33. }
  34. "close" {
  35. if {[tk_messageBox -type yesno -message {Shall I stop?}]} {
  36. break
  37. }
  38. }
  39. "flash" { ;# needs a better alert method
  40. raise .transient
  41. .transient.b flash
  42. bell
  43. }
  44. }
  45. }
  46. destroy .transient
  47. }
  48. }
  49.  
  50. Coobj create foo
  51.