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 $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:

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.