Purpose: to provide Neil Madden's five line Tkhtml based web page displayer.
This app fetches a web page, formats it, and displays it in a tk scrollable widget. It currently does not handle redirecting URLs, makin the web pages active, or ease of changing fonts, etc.
Perhaps some variant of this would be a useful proc for tklib.
package require Tkhtml;package require http;pack [scrollbar .vsb \
-orient vertical -command {.html yview}] -side right -fill y;pack \
[html .html -bg white -yscrollcommand {.vsb set}] -fill both -expand 1
set t [http::geturl http://mini.net/tcl/976.html];.html parse \
[http::data $t];http::cleanup $tNEM - Redirecting URLs aren't too hard. Perhaps there should be an option in the http package though? http::config -followredirects 1. The HTTP codes which indicate a redirect are 301 and 302, so the following should do:
proc geturl_followredirects {url} {
set t [http::geturl http://wiki.tcl.tk]
while {([http::ncode $t] == 301) || ([http::ncode $t] == 302)} {
upvar #0 $t state
array set meta $state(meta)
set t [http::geturl $meta(Location)]
}
return $t
}Next, we probably want images too, so the following can be useful:
image create photo default -data {
R0lGODdhJAAkAPEAAACQkADQ0PgAAAAAACwAAAAAJAAkAAACmISPqcsQD6OcdJqKM71PeK15
AsSJH0iZY1CqqKSurfsGsex08XuTuU7L9HywHWZILAaVJssvgoREk5PolFo1XrHZ29IZ8oo0
HKEYVDYbyc/jFhz2otvdcyZdF68qeKh2DZd3AtS0QWcDSDgWKJXY+MXS9qY4+JA2+Vho+YPp
FzSjiTIEWslDQ1rDhPOY2sXVOgeb2kBbu1AAADv/
}This creates a nice default image for us (a red cross if I remember correctly). Then we need a proc for fetching the images:
proc FetchImage {src w h args} {
# Fetch the image
if {[catch {
http::geturl $src -timeout 10000
} token]} {
return default
}
set data [http::data $token]
http::cleanup $token
# Hack needed to make sure the data is binary:
binary scan $data {}
set name [image create photo]
if {[catch {$name put $data} ret]} {
return default
}
return $name
}You could add caching to this, but I leave that as an exercise. So, we can put this all together:
.html configure -imagecommand FetchImage -hyperlinkcommand \
geturl_followredirects