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

#
package require Tk
wm withdraw .

oo::class create Coobj {
    constructor args {
        toplevel .win
        pack [button .win.b -text "Start doing stuff!" -command [list [self] dostuff]]
    }

    method dostuff {} {

        # this plumbing can be trivially hidden away:
        if {[info coroutine] eq ""} {
            if {[info commands [self namespace]::dostuff] ne ""} {
                # coroutine is already running - bring it to the foreground
                tailcall dostuff flash
            } else {
                # restart this method as a coroutine
                tailcall coroutine [self namespace]::dostuff [self] dostuff
            }
        }

        # method body runs in a coroutine:
        toplevel .transient
        wm transient .transient .win
        wm protocol .transient WM_DELETE_WINDOW [list [info coroutine] close]
        pack [button .transient.b -text "Finish it!" -command [list [info coroutine] dismiss]]
        while {1} {
            switch [yield] {
                "dismiss" {
                    break
                }
                "close" {
                    if {[tk_messageBox -type yesno -message {Shall I stop?}]} {
                        break
                    }
                }
                "flash" {   ;# needs a better alert method
                    raise .transient
                    .transient.b flash 
                    bell
                }
            }
        }
        destroy .transient
    }
}

Coobj create foo