[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. ---- [Peter Newman] 14 April 2005: 1. Am I correct in assuming that this can't currently handle '''resuming''' downloads? 2. 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? ---- See also * [progressbar] * [Indeterminate Progress Bar with Tile] * [Progress Bar (Fellows)] * [Tcl Progress Meter] * [canvas progress bar widget] * [poor man's progressbar] * [progressbars] ---- [Category Widget] | [Category GUI]