Version 7 of Simple Tkhtml web page displayer

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

NEM - 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

Add a wrapper for the hyperlinks:

 proc geturl {url} {
     set t [geturl_followerdirects $url]
     .html clear
     set data [http::data $t]
     .html parse $data
     http::cleanup $t
     # Get the bgcolor and stuff.
     if {[regexp -nocase {<title>(.*)</title>} $data -> title]} {
        wm title . $title
     }
     if {[regexp -nocase {<body[^>]+bgcolor=([^>]+)>} $data -> bgcolor]} {
         set bgcolor [string trim [lindex $bgcolor 0] \"]
         catch {.html configure -bg $bgcolor}
     }
 }

Missing items -

 package require Img

goes a long way in helping images work.

You need some sort of resolution for URLs as a lot of them are not properly formed when passed from Tkhtml, so http packages croaks on them. Usually just a case of adding a http:// to the front.
Fonts can be done with the -fontcommand configuration option.
configuring -scriptcommand script, and then setting 'script' as a proc which returns nothing, can solve some problems with not updating properly.

So, the final stage:

 proc script {args} {}
 .html configure -scriptcommand script
 geturl http://www.slashdot.org

Category Application, Tkhtml, http