Version 14 of Simple Download Progress Widget
Updated 2004-01-22 19:20:36NEM 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.
Screenshot
# -*- tcl -*-
# vim: ft=tcl
package require Tk
package require http
package provide dlprogress 1.1
# Download progress dialog box
namespace eval dlprogress {
variable uniqueId 0
variable data
variable closeWhenComplete 0
namespace export dlprogress
}
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
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
canvas $t.p.prg -bg white -height 15 -width 100 -relief sunken -bd 2
label $t.p.per -width 3 -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
set data($id,prg) [$t.p.prg create rect 0 0 0 20 -fill navy]
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
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
set data($id,token) [http::geturl $data($id,url) \
-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
set pwidth [expr {([winfo width $t.p.prg] / 100.0) * $percent}]
$t.p.prg coords $data($id,prg) 0 0 [expr {int($pwidth)}] 20
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
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
GetUrl $id
return
} elseif {[string match 2?? [http::ncode $token]]} {
$t.bs.cancel configure -state disabled
$t.done configure -text "Done"
# Save the 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"
$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/tcl845-src.zip 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.