Version 11 of Simple Download Progress Widget

Updated 2004-01-21 21:26:44

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


 # -*- tcl -*-
 # vim: ft=tcl

 package require Tk
 package require http
 package provide dlprogress 1.1

 # 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,start) [clock seconds]
         set data($uniqueId,close) $closeWhenComplete
         set data($uniqueId,speed) "0 Bytes/Sec"
         # 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_l -text "Source:" -anchor e
     label $t.src -text $data($id,url) -width 60 -anchor w
     label $t.dst_l -text "Destination:" -anchor e
     label $t.dst -text [file nativename $data($id,file)] \
        -width 60 -anchor w
     label $t.prg_l -text "Progress:" -anchor e
     set data($id,progress) [list 0 ??]
     # Create the progressbar
     frame $t.p
     canvas $t.p.prg -bg white -height 15 -width 100 -relief sunken -bd 2
     label $t.p.per -width 3 -text "0%"
     grid $t.p.prg $t.p.per -sticky ew
     grid columnconfigure $t.p 0 -weight 1
     grid columnconfigure $t.p 1 -weight 0
     set data($id,prg) [$t.p.prg create rect 0 0 0 20 -fill navy]
     label $t.done_l -text "Status:" -anchor e
     label $t.done -text "0/?? bytes (at 0 Bytes/Sec)" -anchor w
     label $t.left_l -text "Time Left:" -anchor e
     label $t.left -text "??" -anchor w
     label $t.elapsed_l -text "Time Elapsed:" -anchor e
     label $t.elapsed -text "00:00:00" -anchor w
     frame $t.bs
     button $t.bs.cancel -command [list [namespace code Cancel] $id] \
        -text "Cancel" -width 8
     button $t.bs.ok -command [list [namespace code Destroy] $id] \
        -text "OK" -state disabled -width 8
     pack $t.bs.cancel $t.bs.ok -anchor e -side right -padx 2 -pady 4
     checkbutton $t.close \
         -variable [namespace current]::data($id,close) \
         -text "Close dialog when complete" -anchor w
     # Pack everything
     grid $t.src_l $t.src -sticky ew
     grid $t.dst_l $t.dst -sticky ew
     grid $t.done_l $t.done -sticky ew
     grid $t.left_l $t.left -sticky ew
     grid $t.elapsed_l $t.elapsed -sticky ew
     grid $t.prg_l $t.p -sticky ew
     grid $t.close -columnspan 2 -sticky ew
     grid $t.bs -columnspan 2 -sticky ew
     wm title $t "0% of [file tail $data($id,file)]"
     wm resizable $t 0 0
     wm protocol $t WM_DELETE_WINDOW [list [namespace code Cancel] $id]
 }

 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    GB
             1048576.0       MB
             1024.0          KB
             1               Bytes
     } {
         if {($size / $div) > 1} {
             return "[format %.2f [expr {double($size)/$div}]] $unit"
         }
     }
     # Reached in the case where size == 0
     return "$size Bytes"
 }

 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}]
         set data($id,speed) "[FormatUnits $speed]/Sec"
         # Work out time left
         set left [expr {int(($expected - $received)/$speed + 1)}]
         $t.left configure \
            -text [clock format $left -format %H:%M:%S -gmt 1]
         set elapsed [expr {$ts - $data($id,start)}]
         $t.elapsed configure -text [clock format $elapsed -format %H:%M:%S -gmt 1]
         set data($id,progress) [list $received $expected]
         # Update title
         wm title $t "${percent}% of [file tail $data($id,file)]"
     }
     # Update labels
     set pwidth [expr {([winfo width $t.p.prg] / 100.0) * $percent}]
     $t.p.prg coords $data($id,prg) 0 0 [expr {int($pwidth)}] 20
     set txt "[FormatUnits $received]/[FormatUnits $expected] (at $data($id,speed))"
     $t.p.per configure -text "${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"} {
         # Destroy the window...
         Destroy $id
     } 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.bs.cancel configure -state disabled
             $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 {
                $t.bs.ok configure -state normal
             }
         } 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]"
         }
         wm protocol $t WM_DELETE_WINDOW [list [namespace code Destroy] $id]
         $t.left configure -text "00:00:00"
         $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!


MDD Very nice!

KPV I'd love to see this combined with wish-reaper.

NEM To combine it with wish-reaper, you would have to change the code slightly to allow a callback instead of writing to a file. This is so that wish-reaper can filter the html before writing to file. I might change the code so that it works as a callback, rather than doing the download itself.

NEM Added some "-gmt 1" options to the [clock format] statements so that it prints actually accurate times.