Posted to tcl by patthoyts at Mon Feb 25 11:55:33 GMT 2008view pretty
# Text widget filling in the background (with progress) # run with: tclkit-gui jdc-text.tcl package require Tk 8.5 proc Test {} { set dlg [toplevel .t[clock clicks] -class Dialog] wm withdraw $dlg set txt [text $dlg.txt] ttk::scrollbar $dlg.vs -command [list $txt yview] $txt configure -yscrollcommand [list $dlg.vs set] ttk::progressbar $dlg.pr grid $dlg.txt $dlg.vs -sticky news grid $dlg.pr - -sticky ew grid rowconfigure $dlg 0 -weight 1 grid columnconfigure $dlg 0 -weight 1 bind $dlg <Control-F2> {console show} after 1000 [list Load $dlg 0 65000 1000] wm deiconify $dlg tkwait window $dlg } variable Chunk 0 proc Load {dlg start limit chunk} { variable Chunk; incr Chunk variable Start; if {![info exists Start]} { set Start [clock clicks -milliseconds] } puts stderr "$Chunk [clock clicks -milliseconds]" for { set cn 0; set i $start } { $cn < $chunk && $i < $limit} { incr i ; incr cn } { $dlg.txt insert end "This is " a "line " b $i [list c $i] " and is has " d 7 e " tags." f \n {} } $dlg.pr configure -value [expr {($i * 100) / $limit}] if {$i < $limit} { after idle [list after 10 [list Load $dlg $i $limit $chunk]] } else { variable End [clock clicks -milliseconds] puts stderr [expr {double($End - $Start) / 1000}] } } if {!$tcl_interactive} { wm withdraw . set r [catch [linsert $argv 0 Test] err] if {$r} { tk_messageBox -icon error -title [info script] -message $err } exit $r }