[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. [NEM] '''25Jan2006''' - Refactored the code into a [snit] view widget that knows nothing about HTTP or any other protocol, separating presentation from the actual downloading. This means that the widget no longer handles the actual download for you, but on the plus side it should be much more flexible. I've also added a little public domain icon from http://www.openclipart.org/ to make it look a little prettier. The code now relies on both [snit] and [tile]. I might add back in the tile-independence, but snit is here to stay. Next on the agenda is a proper mini-version so that you can put lots of these into a scrollable frame much like Firefox's download window. (Similar to Zipguy's version). BTW - moving the network protocol code out of the widget means that I can effectively avoid issues of resuming downloads etc -- that's not my problem anymore! :-) More seriously, the proper place for such code is probably the [uri] package in [tcllib], although that could do with some work (which I might in fact do at some point). Due to the major interface change I bumped the version number to 2.0 just in case anyone is actually using this. '''Screenshot''' [http://www.cs.nott.ac.uk/~nem/dlprogress.gif] WinXP - no tile (old version) [http://www.cs.nott.ac.uk/~nem/dlprogress.png] Mac OS X - with tile and icon (new version) [Zipguy] 06/2005 I needed a smaller version of the download dialog. It works great! ---- ====== # dlprogress.tcl -- # # A Simple Download Progress Widget. # http://wiki.tcl.tk/10571 # # Copyright (c) 2005-2006 Neil Madden. # # License: http://www.cs.nott.ac.uk/~nem/license.terms (Tcl-style) package require Tcl package require Tk package require tile package require snit snit::widget dlprogress { option -source "unknown" option -destination "unknown" variable done variable ts variable start variable speed variable progress constructor {args} { set done 0 set ts [clock seconds] set start [clock seconds] set speed "0 Bytes/Sec" set progress [list 0 ??] $self configurelist $args $self CreateProgressDialog } method CreateProgressDialog {} { # Source URL ttk::label $win.logo -image $networkImg ttk::label $win.src_l -text "Source:" -anchor e ttk::label $win.src -text $options(-source) -width 40 -anchor w # Destination file ttk::label $win.dst_l -text "Destination:" -anchor e ttk::label $win.dst -text [file nativename $options(-destination)] \ -width 40 -anchor w # Bytes transferred and rate ttk::label $win.done_l -text "Status:" -anchor e ttk::label $win.done -text "0/?? bytes (at 0 Bytes/Sec)" -anchor w # Time remaining and elapsed ttk::label $win.left_l -text "Time Left:" -anchor e ttk::label $win.left -text "??" -anchor w ttk::label $win.elapsed_l -text "Time Elapsed:" -anchor e ttk::label $win.elapsed -text "00:00:00" -anchor w # Progress bar and percentage done ttk::label $win.prg_l -text "Progress:" -anchor e $self MakeProgBar $win.p grid $win.logo -sticky nsew grid ^ $win.src_l $win.src -sticky ew grid ^ $win.dst_l $win.dst -sticky ew grid ^ $win.done_l $win.done -sticky ew grid ^ $win.left_l $win.left -sticky ew grid ^ $win.elapsed_l $win.elapsed -sticky ew grid $win.prg_l $win.p - -sticky ew } method MakeProgBar path { ttk::frame $path ttk::progressbar $path.prg -maximum 100 -length 100 $path.prg configure -value 0 ttk::label $path.per -width 4 -text "0%" grid $path.prg $path.per -sticky ew grid columnconfigure $path 0 -weight 1 } # Callback to update status during download. Call with total expected # bytes and received so far. method progress {expected received} { if {$expected == 0} { return } lassign $progress got total set now [clock seconds] # Work out percent download, and speed set percent [expr {int(100.0 * (double($received)/double($expected)))}] set byteDiff [expr {$received - $got}] set tsDiff [expr {$now - $ts}] if {$tsDiff > 0} { set rate [expr {$byteDiff/$tsDiff}] set speed "[$self FormatUnits $rate]/Sec" # Work out time left set left [expr {int(($expected - $received)/$rate + 1)}] $self.left configure \ -text [clock format $left -format %T -gmt 1] set elapsed [expr {$now - $start}] $self.elapsed configure \ -text [clock format $elapsed -format %T -gmt 1] set progress [list $received $expected] } $win.p.prg configure -value $percent set txt "[$self FormatUnits $received]/[$self FormatUnits $expected]" append txt " (at $speed)" $self.p.per configure -text "${percent}%" $self.done configure -text $txt set ts $now } # Format a byte size in most appropriate units, up to Gigabyte size. method FormatUnits size { 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" } } return "$size Bytes" } # Base-64 encoded GIF image representing a network, from # http://www.openclipart.org/ -- Public Domain. typevariable networkImg typeconstructor { set networkImg [image create photo -data { R0lGODlhUABQAOYAAAAAADBYgMjIyEiAsMDI2LjI0FBwkJigsNjY4NDQ0Ehw kGiYwKCgoLDAyJCwyDBomFCIsDhwoKiwsKCoqFB4mFCAqKiosFB4oFiIqNDY 2JCoyICo0ICo2ICgwFh4oFh4mFiAoFiAqFiAsGiQsMjQ2MjQ0ICgyEh4oEBw oFB4qJCgqChYkFiQuMDQ2EhwmEBwmJiYmChgkChYiFiIsFiIuLi4uKiwuIio yICowICoyIiowDhomDBgmDBYiJiYoKCgqDBgkEB4oKioqLC4uHiYuKCosGCQ sGCIsEh4qEB4qEiAqGiYyLjA0ICw2GCQwLi4wLCwuHCgyGCQuGCIuLC4wLCw sHCYuFCAsHCYyHCYwMDAwGiYuGiQuHCQuGiQwMDI0MjI0LjAyNjg4NDQ2Hig yHig0HigwHio0DhooDhwmIiw2NjY2ODg4ODg6Ojo6ODo6Ojo8PDw8JigqGiI sHiYwMDIyJigoMDAyLjAwAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAHkA LAAAAABQAFAAAAf/gHmCg4SFhoeIiYqLjI2Oj5CRkpOUlZaXmJmam5prnmts oaJsbqWmpXGpqZybn5+jo6enqnGsma6vsKGypqq2mAlrd1TExEM2yMhFy0UH cs8qRau/lgkJdxxNTRtnUVELC1I0M1dKSEEoOw9AcqXU1ddNattnZVFLC040 NFcDSEko0Dzg0c7Nu0rW6pzZwM0elnziyJlDp46du4OTEpbZ6O0bRBoQriBB giKCuhgHLmKMZO0LFm9Y8HlxErHcv5IDYxRRufKRgARgwIFzQnMfOX8ATa7T SapnJAECwEiZOtXoFZtJ1fGIsaJIKKeQoJbYZzTk1ZFZc66QYeMrWEdi/6/K tXmzpFauMti6fcsIKomRgP+hs/tg6dq8bdnwbfSTBIrHkEsqXYo3b48hexcn +jkmgmc0O0IXpnxYRo8eAaiA0rwoWIYKsGFfmH3ihIvbuBUY2K16DWtFrjOM GT48QYnjyI+DWb48mO/fiBKwcWWteoKf1qvjgo5IgCjq2bFnd8X9kBZQ3z9l X6/9eflCWrRUmU+/So37+PPf1yLgfSItMAQo4IAEEliFf4Xg4gl74UHloIOE KKjLhLxUSAsth6why4TpKbhgMP3l4aEnHMJSIS8XThMhKW6MgguLLcKCC1SC jEhiiaKcKEuKhkgXYygLfvIjkLhYp0WNNqKHI/+MOrpxYY+ggCfeGvFpoV8N 9dUQH5JrMDiec0mOyIYvhfz04XUC8AdVgw9WaWUNgjiXgBZ44PHEnU/UMMQQ UPQJhQSASmDBoBZMYOgPiP5gx6J2+DCBk7XA92CaVTroZpVXYjlfnMEk0IA2 oHJwxqijkmHqqSakmkMON7SKgxUzPGYSBY86ad6lbmaaX331cWpNGNqoMQ89 pZ5qqgmrJttqqw44YAYSs9ZqUE/WAQtqE6KO2pE3xpJhRgcdIMtqqxrccMIO FwhhilPVMsQBB9yMak8UWNSbxb34mqGvvuB2oIMOHURwgQXrUltdGKQmPO89 QjWM77107NvvER4QzNP/QdYxsdHGCzM8FFVScCEyF1tYYbIVRBBhhhUeSFDw StYVsO22MQlFlDg0TAHyyCJ3YTIRIFTxsiMBZlRdAS/BFBM+Q9GE8zgzRB31 EVQbMcIIXHQR9NCNCChJzA2HPZPTZJEzlwgiSE31EXOAAAXXjHj9FHZfiE3U zVKwULZc5owUWwUhhIABBiBg1hQkcoe15hd33w0yWeOYRdc/SQSWAmweGK4Y 4kXP/dMXIE+lN+QzSE5XEgCVBFltJ1xQgyiRJO7T4jQ8TToEpvctmKwmhZbG Cyhc8ATsnMMgiYMJEFB7RLibfpXudUmmzmgP7EABHsQ/IjtcaxIwAxdSTBH1 /1zlQJ/EYJ6JVhgQMcQAxPXZE9254j8RcIXI4Y8PPeWQedZ7YTxgH1dWQAEt xK9r85vdT1qAhJFJ4QgzEAFsKDcYyfxvfe0boAw+YMDMINB4T6lOC5JQASuI zAgQvEIFRtK/9E1vIALU4AbvcMC4JRAu1lhDCx5TgS6IjGozCMEKT2AX9cEw gysozQbrgJ7Y3ZAxOWyB/4JwBC6MgGoSXOFj1BfADMowLxsUAImcCMKwdGkN JAiNGiNwAiTUBjJpEM1WkJhEMFqmBx8QoyfIeLxPxAEOcJDFG9rQhlGIQQwI QAAuMiCc7CDnE3x8ypm8RMn1hCmSYZmOghj0oErm0P9DmPRJh9TjpTV5EpTF K5Aqy5gH77hok+wxZSUVRMZVqnIQHZQRLGPpSTC5R3u2vKUg4qMkInmol16C pFO0hCtcTeqZsqSkZmrAgGpa85rYzKY2r3mg31Bzm+AMJzf5UiRPQvOck1LT gw5SzCWFyUalPNIvfFShJeninbBM0y809MpyFjNM5jSlPFmBniEZM0iuqGeJ RgSVgXJCOv8spx5zwaEkNcihm/BlOasjHmtMZz3obGilKAUnW3SKlNax1Hjk wyv6COGlMI2pEBggBEz9QoyxTCdHsZPOZsYnU28qKSt+wtOe/nRSO4WmT3+6 q5uiyVKXwk+blhrUTLUUS78lUKdIqUpVXVl1PpqiBldz5VVdtfSs3XxHWdeK 1ra6VAgIekcgAAA7 }] } } ====== Now, as I've cut all the networking code out of the widget, our example is a bit longer than it needs to be. I need to work out how best to split this functionality into other packages so that we can reduce this to a simple 3-liner again: ====== package require Tk 8.4 package require tile package require dlprogress 2.0 package require http array set DownloadState { uniqueId 0 } # Fetch a URL to a given file proc geturl {url to} { global DownloadState # Try to open file before anything else set out [open $to.download w] fconfigure $out -translation binary # Create progress dialog set w [toplevel .dl[incr DownloadState(uniqueId)]] set prog [dlprogress $w.progress -source $url -destination $to] # Initialise state set DownloadState($w,close) 0 set DownloadState($w,out) $out set DownloadState($w,file) $to # Create a minimal user interface ttk::frame $w.bs ttk::button $w.bs.cancel -command [list ::cancel $w] \ -text "Cancel" -width 8 ttk::button $w.bs.ok -command [list ::destroy $w] \ -text "OK" -width 8 -state disabled pack $w.bs.cancel $w.bs.ok -anchor e -side right -padx 2 -pady 4 ttk::checkbutton $w.close -variable ::DownloadState($w,close) \ -text "Close dialog when complete" grid $prog -sticky ew grid $w.close -sticky ew grid $w.bs -sticky ew -padx {0 10} wm title $w "0% of [file tail $to]" wm resizable $w 0 0 wm protocol $w WM_DELETE_WINDOW [list ::cancel $w] # Fetch the URL set token [http::geturl $url -channel $out \ -progress [list ::progress $w] \ -command [list ::cleanup $w]] set DownloadState($w,token) $token return $w } # Progress callback to update display proc progress {w token expected received} { global DownloadState # Update download progress widget $w.progress progress $expected $received # Update window title set percent [expr {int(100.0 * double($received)/double($expected))}] wm title $w "${percent}% of [file tail $DownloadState($w,file)]" } # Called when user clicks the cancel button proc cancel w { global DownloadState http::reset $DownloadState($w,token) "cancelled" } # Called when download ends proc cleanup {w token} { variable DownloadState # Close output file catch {close $DownloadState($w,out)} if {[http::status $token] eq "cancelled"} { # User cancelled the download destroy $w } else { # Assume download went fine (i.e. HTTP 200 return code) # This would be the place to handle redirects etc $w.bs.cancel configure -state disabled $w.close configure -state disabled $w.bs.ok configure -state normal wm title $w "100% of [file tail $DownloadState($w,file)]" if {$DownloadState($w,close)} { destroy $w } else { # Reset window deletion handler to its usual wm protocol $w WM_DELETE_WINDOW [list ::destroy $w] } # Move file to requested name file rename -force $DownloadState($w,file).download \ $DownloadState($w,file) http::cleanup $token } foreach item [array names DownloadState $w,*] { catch { unset DownloadState($item) } } } # Grab Tcl 8.4.12 sources set url http://heanet.dl.sourceforge.net/sourceforge/tcl/tcl8.4.12-src.tar.gz set file [tk_getSaveFile] geturl $url $file ====== ---- Hope you like it! ---- '''Comments''' ''Most of the comments below refer to older versions of the widget'' ---- [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? [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. [DK] I think in theory http 1.1 supports resuming, via what the call "range requests". Support is patchy in both servers and clients though. ---- [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. [Mookie] I have updated it with the new ::ttk::progressbar. ---- See also * [progressbar] * [Indeterminate Progress Bar with Tile] * [Progress Bar (Fellows)] * [Tcl Progress Meter] * [canvas progress bar widget] * [poor man's progressbar] * [progressbars] <> Widget | GUI