[NEM] '''19Dec2003''' - I just made a simple widget package for handling downloads (like the progress meters you get in web browsers). It's quite a simple little thing, but it works ok. It has some flaws (particularly that it always saves files as binary, and it only supports http), but I thought it might make a useful starting point if anyone is in need of such a widget. Consider this in the public domain.

'''Screenshot'''

[http://mod3.net/~nem/dlprogress.gif]

----
 #!/bin/sh
 # -*- tcl -*-
 # vim: ft=tcl
 
 package require Tk
 package require http
 package provide dlprogress 1.0
 
 # Download progress dialog box
 namespace eval dlprogress {
     variable uniqueId 0
     variable data
     variable closeWhenComplete 0
     namespace export dlprogress
 }
 proc dlprogress::dlprogress {url} {
     variable uniqueId
     variable closeWhenComplete
     variable data
     set file ""
     regexp {http://.*/([^/]+)$} $url -> file
     # Pick a file to save to
     set file [tk_getSaveFile -initialfile $file]
     if {[string length $file]} {
         set data($uniqueId,url) $url
         set data($uniqueId,file) $file
         set data($uniqueId,done) 0
         set data($uniqueId,ts) [clock seconds]
         set data($uniqueId,close) $closeWhenComplete
         # Create the progress dialog
         CreateProgressDialog $uniqueId
         # Start the download
         GetUrl $uniqueId
         set id $uniqueId
         incr uniqueId
     }
     return
 }
 
 proc dlprogress::CreateProgressDialog {id} {
     variable data
     set t [toplevel .progress$id]
     label $t.src -text "Source: $data($id,url)" -width 40 -anchor w 
     label $t.dst -text "Destination: $data($id,file)" -width 40 -anchor w
     set data($id,progress) [list 0 ??]
     # Create the progressbar
     canvas $t.prg -bg white -height 15 -width 100 -relief sunken -bd 2
     set data($id,prg) [$t.prg create rect 0 0 0 20 -fill navy]
     label $t.done -text "0/?? bytes (0%)"
     label $t.speed -text "0KB/Sec"
     checkbutton $t.close \
         -variable [namespace current]::data($id,close) \
         -text "Close dialog when complete"
     # Pack everything
     pack $t.src $t.dst -anchor w
     pack $t.prg -fill x
     pack $t.done $t.speed $t.close -anchor w
     pack [button $t.cancel -command [list [namespace code Cancel] $id] \
         -text "Cancel"] -anchor e
     wm title $t "Download Progress"
     wm resizable $t 0 0
 }
 
 proc dlprogress::GetUrl {id} {
     variable data
     # Fetch the URL to the file
     set data($id,token) [http::geturl $data($id,url) \
             -progress [list [namespace code Progress] $id] \
             -command [list [namespace code Cleanup] $id]]    
 } 
 
 proc dlprogress::Cancel {id} {
     variable data
     http::reset $data($id,token) "Cancelled"
 }
 
 proc dlprogress::FormatUnits {size} {
     # Return the item formatted to 2d.p. with appropriate units
     foreach {div            unit    } {
             1073741824.0    GBytes 
             1048576.0       MBytes
             1024.0          KBytes 
             1               bytes
     } {
         if {($size / $div) > 1} {
             return "[format %.2f [expr {double($size)/$div}]] $unit"
         }
     }
     # Should never be reached (any numbers which don't divide by 1?!)
     return "$size ??"
 }
 
 proc dlprogress::Progress {id token expected received} {
     variable data
     if {$expected == 0} { return }
     set t .progress$id
     foreach {got total} $data($id,progress) {break}
     # Work out percent download, and speed
     set ts [clock seconds]
     set percent [expr {int(100.0 * (double($received)/double($expected)))}]
     set byteDiff [expr {$received - $got}]
     set tsDiff [expr {$ts - $data($id,ts)}]
     if {$tsDiff > 0} {
         set speed [expr {$byteDiff/$tsDiff}]
         $t.speed configure -text "[FormatUnits $speed]/Sec"
         set data($id,progress) [list $received $expected]
     }
     # Update labels
     set pwidth [expr {([winfo width $t.prg] / 100.0) * $percent}]
     $t.prg coords $data($id,prg) 0 0 [expr {int($pwidth)}] 20
     set txt "[FormatUnits $received]/[FormatUnits $expected] (${percent}%)"
     $t.done configure -text $txt
     # Update state
     set data($id,ts) $ts
 }
 
 proc dlprogress::Cleanup {id token} {
     variable data
     variable closeWhenComplete
     # Check the status
     set t .progress$id
     if {[http::status $token] eq "Cancelled"} {
         $t.cancel configure -text "OK" -command \
             [list [namespace code Destroy] $id]
         $t.done configure -text "Cancelled"
         $t.prg coords $data($id,prg) 0 0 [winfo width $t.prg] 20
     } else {
         if {[http::ncode $token] == 301 || [http::ncode $token] == 302} {
             # Redirect
             upvar #0 $token state
             array set meta $state(meta)
             set data($id,url) $meta(Location)
             http::cleanup $token
             GetUrl $id
             return
         } elseif {[string match 2?? [http::ncode $token]]} {
             $t.cancel configure -text "OK" -command \
                 [list [namespace code Destroy] $id]
             $t.done configure -text "Done"
             # Save the file
             set fid [open $data($id,file) w]
             fconfigure $fid -translation binary -encoding binary
             puts -nonewline $fid [http::data $token]
             close $fid
             http::cleanup $token
             if {$data($id,close)} {
                 set closeWhenComplete 1
                 Destroy $id
             }
         } else {
             # Bad status code from HTTP... what to do here?
             $t.cancel configure -text "OK" -command \
                 [list [namespace code Destroy] $id]
             $t.done configure -text "ERROR: [http::ncode $token] [http::status $token]"
         }
     }
     $t.close configure -state disabled
     # Cleanup state
     foreach item [array names data $id,*] {
         catch {unset data($item)}
     }
 }
 
 proc dlprogress::Destroy {id} {
     catch {destroy .progress$id}
 }
----
And a little example of usage (download the Tcl sources):
 
 package require dlprogress 
 set url http://heanet.dl.sourceforge.net/sourceforge/tcl/tcl845-src.zip
 dlprogress::dlprogress $url
----
Hope you like it!