Version 20 of Simple Download Progress Widget

Updated 2005-04-14 01:54:08 by schlenk

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

http://www.cs.nott.ac.uk/~nem/dlprogress.gif

WinXP - no tile

http://www.cs.nott.ac.uk/~nem/progress1.png

Mac OS X - with tile


 # -*- 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.


See also


Category Widget | Category GUI