[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. '''Screenshot''' [http://mod3.net/~nem/dlprogress.gif] ---- # -*- 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. ---- [Category Widget] | [Category GUI]