Posted to tcl by hypnotoad at Fri Nov 30 21:07:09 GMT 2018view raw

  1. namespace eval ::test {}
  2. package require taotk
  3.  
  4. oo::class create ::test::fake {
  5. constructor args {
  6. after 5000 [namespace code {my trigger}]
  7. }
  8. destructor {
  9. puts [list [self] is dead]
  10. }
  11. method trigger {} { set ::response ok }
  12. }
  13.  
  14. proc ::test::dialog args {
  15. destroy .prompt
  16. set ::response {}
  17. set info [::tool::args_to_options {*}$args]
  18. set class ::taotk::dialog.[dict getnull $info type]
  19. if {[info command $class] eq {}} {
  20. set class ::taotk::dialog.ok
  21. }
  22. dict set info varname ::response
  23. puts [list CREATE OBJECT] ; update
  24. #set tempobj [$class create prompt .prompt {*}$info]
  25. set obj [::test::fake new]
  26. rename $obj .prompt
  27. set testobj .prompt
  28.  
  29. if {[info coroutine] eq {}} {
  30. puts [list VWAIT] ; update
  31. ::vwait ::response
  32. } else {
  33. puts [list COROUTINE VWAIT] ; update
  34. ::coroutine::util::vwait ::response
  35. }
  36. puts [list DESTROY] ; update
  37. catch {$tempobj destroy}
  38. puts [list RETURN $::response] ; update
  39. return $::response
  40. }