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
}