Posted to tcl by patthoyts at Tue Feb 26 22:48:20 GMT 2008view raw
- package require Tk
- if {![package vsatisfies [package provide Tk] 8.5]} {
- set auto_path [concat /opt/tcl/site-lib/tile0.8.2 $auto_path]
- package require tile
- }
- source [file join [file dirname [info script]] http.tcl]
- set auto_path [concat /opt/tcl/site-lib/tls1.5.1 $auto_path]
- package require tls
- http::register https 443 ::tls::socket
- proc Progress {tok total count} {
- .status.progress configure -value [expr {($count * 100) / $total}]
- }
- proc Command {tok} {
- .t insert end "$tok [http::status $tok]\n" {}
- catch {
- for {set level 0} {1} {incr level -1} {
- .t insert end "\t[info level $level]\n" {}
- }
- }
- if {[http::status $tok] eq "error"} {
- .t insert end "error: [http::error $tok]\n" {}
- }
- .t insert end "\n[http::meta $tok]\n" {}
- ::http::cleanup $tok
- }
- proc Fetch {url} {
- if {[catch {http::geturl $url \
- -timeout 10000 \
- -progress Progress \
- -command Command} err]} {
- .t insert end "Caught error: $err\n" {} $::errorInfo\n {}
- catch {
- for {set level 0} {1} {incr level -1} {
- .t insert end "\t[info level $level]\n" {}
- }
- }
- }
- }
- proc Main {url} {
- text .t -yscrollcommand {.vs set}
- scrollbar .vs -command {.t yview}
- ttk::frame .status
- ttk::label .status.pane0
- ttk::progressbar .status.progress
- ttk::sizegrip .status.sizegrip
- grid .status.pane0 .status.progress .status.sizegrip -sticky news
- grid rowconfigure .status 0 -weight 1
- grid columnconfigure .status 0 -weight 1
- grid .t .vs -sticky news
- grid .status - -sticky ew
- grid rowconfigure . 0 -weight 1
- grid columnconfigure . 0 -weight 1
- bind . <Control-F2> {console show}
- after 250 [list Fetch $url]
- tkwait window .
- }
- if {!$tcl_interactive} {
- set r [catch [linsert $argv 0 Main] err]
- if {$r} {
- tk_messageBox -icon error -title [info script] -message $::errorInfo
- } elseif {[string length $err]>0} {
- tk_messageBox -icon info -title [info script] -message $err
- }
- exit $r
- }