Version 29 of Simple Download Progress Widget

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.

NEM 21Feb2005 - Minor update to use Tile if available.

NEM 14Apr2005 - Another minor update to improve handling of large files. The code now uses the -channel option of http::geturl in order to download directly to disk. Before, it was downloading into memory, and then writing out (nasty!). In order to avoid clobbering an existing file, if you cancel (or your app crashes) halfway through a download, it downloads to a file called $file.download (where $file is the filename you've chosen), and then renames the file when everything has completed ok. I think the code is basically ok, and should also handle redirects, etc correctly. As we have a .download file available, it should be possible to code up resumable download support, but I'm not sure if Tcl's http package supports that (I haven't checked the docs). I might spin this off into a general purpose download manager (for tcllib) along with some GUI front ends for tklib.

schlenk In http package could support it, you would have to use the HTTP1.1 Range headers and parse the 206 return codes and byterange mimetype.

Screenshot

WinXP - no tile

Mac OS X - with tile

Zipguy 06/2005 I needed a smaller version of the download dialog. It works great!

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

 package require Tk
 package require http
 # This should be configurable... This whole package needs factoring. :)
 #http::config -proxyhost wwwcache.cs.nott.ac.uk
 #http::config -proxyport 3128
 package provide dlprogress 1.1
 # Tile is optionally require below

 # Download progress dialog box
 namespace eval dlprogress {
     variable uniqueId 0
     variable data
     variable closeWhenComplete 0
     namespace export dlprogress
 }

 # If Tile is available, use it for nicer progress bar
 if {[catch {package require tile 0.6}]} {
    # Not available
    proc dlprogress::MakeProgBar {id w} {
         variable data
         canvas $w -bg white -height 15 -width 100 -relief sunken -bd 2
         set data($id,prg) [$w create rect 0 0 0 20 -fill navy]
    }
    proc dlprogress::UpdateProgBar {id w percent} {
         variable data
         set pwidth [expr {([winfo width $w] / 100.0) * $percent}]
         $w coords $data($id,prg) 0 0 [expr {int($pwidth)}] 20
    }
 } else {
     namespace eval dlprogress {
     namespace import -force ::ttk::* }
    # Use Tile version
    proc dlprogress::MakeProgBar {id w} {
         ttk::progress $w -from 0 -to 100 -length 100 -width 15
         $w set 0
    }
    proc dlprogress::UpdateProgBar {id w percent} {
        $w set $percent
    }
 }

 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
         after 0 [list dlprogress::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
     MakeProgBar $id $t.p.prg
     label $t.p.per -width 4 -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
     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 -padx {0 10}
     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
     #if {[file exists $data($id,file).download]} {
        # We might be able to resume this from here?
     #}
     set data($id,fid) [open $data($id,file).download w]
     fconfigure $data($id,fid) -translation binary -encoding binary
     set data($id,token) [http::geturl $data($id,url) \
             -channel $data($id,fid) \
             -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
     UpdateProgBar $id $t.p.prg $percent
     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
     catch {close $data($id,fid)}
     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
             after 0 [list dlprogress::GetUrl $id]
             return
         } elseif {[string match 2?? [http::ncode $token]]} {
             $t.bs.cancel configure -state disabled
             $t.done configure -text "Done"
             # Copy file to correct name
             file rename -force $data($id,file).download $data($id,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"
         wm title $t "100% of [file tail $data($id,file)]"
         $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/tcl8.4.9-src.tar.gz
 dlprogress::dlprogress $url

Hope you like it!

MDD Very nice!

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

escargo 21 Jan 2004 - Why would you want this combined with wish-reaper? Most pages I reap take only about a second, and a progress bar just does not seem to be of much use? (Of course, I'm connected via DSL, so maybe a progress bar would be of use to modem users.)

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.

When you feel that this is has reached a point that it is working, would you consider adding it to tklib?

NEM Sure. But there's a whole bunch of stuff which would need to be done before then. Factor out the http stuff to maybe use the uri package in tcllib, make it download to file directly (to temp, then copy at end), instead of into memory (downloaded a huge file with it the other day, and started paging badly). I don't really have time to update this myself -- too many other projects. But if someone else wants to, I have no problem with that.

Peter Newman 14 April 2005:

Am I correct in assuming that this can't currently handle resuming downloads?
Am I correct in assuming that http can't handle resuming downloads?

I ask because, with today's file sizes, resuming is pretty much essential for any general-purpose download widget (IMHO). TclCurl can do resuming, but it's a bit more complicated to use than http. And I suspect that http can handle resuming too, with perhaps some extra fiddling. But I've never had the time to find out. Anyone know either way?

NEM Correct on point 1, unsure on point 2. As far as I know, http doesn't (yet) handle resuming downloads, but I've not actually looked into it. It's probably not too much effort to add, but it's way down my list of things to do. Feel free to add that support yourself, of course.

Zipguy 06/2005 This is great!

I posted a screenshot above of my modified version of dlprogress. I'll try to email you to let you know that I've modified the page. It is a LOT smaller and can be run hundreds of times from the same execution sucessfully.

Too make it a lot smaller, I basically I just commented out lots of the "grid"ing of items down to just

     grid  $t.done $t.p  -sticky ew

and then changed the proc dlprogress::FormatUnits to add an if check to remove the units size (KB, MB,etc). I added an if check to see if the units were requested.

         if {[expr [string length $units] - 1]} {
           return "[format %.2f [expr {double($size)/$div}]]"
         } else {
           return "[format %.2f [expr {double($size)/$div}]] $unit"
         }

and lastly I changed the line to omit the units from the $received in the dlprogress::Progress proc:

     set txt    "[FormatUnits $received nounits] of [FormatUnits $expected] at $data($id,speed)"

(note the "FormatUnits $received nounits" call, which asked for no units in the format routine)

NEM Glad you like it. I noticed your screen-shot. Looks nice. One day I might generalise this to be a general download manager. However, before that happens it'd be nice to have a well-thought-out abstraction of network protocols. At present, there is the uri stuff in tcllib which provides a geturl method, but that needs a bit of work to be really useful. I've got other stuff on my plate at the moment, but it's definitely something I'm considering looking at.