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.
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
WinXP - no tile (old version)
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.
# https://wiki.tcl-lang.org/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 $fileHope 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:
- 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.
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