Posted to tcl by patthoyts at Mon Feb 25 11:55:33 GMT 2008view raw

  1. # Text widget filling in the background (with progress)
  2. # run with: tclkit-gui jdc-text.tcl
  3.  
  4. package require Tk 8.5
  5.  
  6. proc Test {} {
  7. set dlg [toplevel .t[clock clicks] -class Dialog]
  8. wm withdraw $dlg
  9. set txt [text $dlg.txt]
  10. ttk::scrollbar $dlg.vs -command [list $txt yview]
  11. $txt configure -yscrollcommand [list $dlg.vs set]
  12. ttk::progressbar $dlg.pr
  13.  
  14. grid $dlg.txt $dlg.vs -sticky news
  15. grid $dlg.pr - -sticky ew
  16. grid rowconfigure $dlg 0 -weight 1
  17. grid columnconfigure $dlg 0 -weight 1
  18.  
  19. bind $dlg <Control-F2> {console show}
  20.  
  21. after 1000 [list Load $dlg 0 65000 1000]
  22. wm deiconify $dlg
  23. tkwait window $dlg
  24. }
  25.  
  26. variable Chunk 0
  27.  
  28. proc Load {dlg start limit chunk} {
  29. variable Chunk; incr Chunk
  30. variable Start; if {![info exists Start]} { set Start [clock clicks -milliseconds] }
  31. puts stderr "$Chunk [clock clicks -milliseconds]"
  32. for { set cn 0; set i $start } { $cn < $chunk && $i < $limit} { incr i ; incr cn } {
  33. $dlg.txt insert end "This is " a "line " b $i [list c $i] " and is has " d 7 e " tags." f \n {}
  34. }
  35. $dlg.pr configure -value [expr {($i * 100) / $limit}]
  36. if {$i < $limit} {
  37. after idle [list after 10 [list Load $dlg $i $limit $chunk]]
  38. } else {
  39. variable End [clock clicks -milliseconds]
  40. puts stderr [expr {double($End - $Start) / 1000}]
  41. }
  42. }
  43.  
  44. if {!$tcl_interactive} {
  45. wm withdraw .
  46. set r [catch [linsert $argv 0 Test] err]
  47. if {$r} {
  48. tk_messageBox -icon error -title [info script] -message $err
  49. }
  50. exit $r
  51. }