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 $url]
     while {([http::ncode $t] == 301) || ([http::ncode $t] == 302)} {
         upvar #0 $t state
         array set meta $state(meta)
         http::cleanup $t
         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
Although, the -hyperlink command doesn't seem to work for me, so try:
 proc HrefBinding {x y} {
     set new [.html href $x $y]
     set new [string trim $new {{}}]
     if {[string length $new]} {
         geturl $new
     }
 }
 bind .html <Button-1> [list HrefBinding %x %y]

Add a wrapper for the hyperlinks:
 proc geturl {url} {
     .html configure -cursor watch
     set t [geturl_followredirects $url]
     .html clear
     set data [http::data $t]
     # Get the url, incase we followed redirects
     upvar #0 $t state
     set url $state(url)
     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}
     }
     .html configure -base $url
     .html parse $data
     .html configure -cursor xterm
 }

''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.
   * This does very little error checking.
   * Applets using TclBlend would be cool.
   * URL resolution using the uri package would work for images.
   * A binding to change the cursor over links:
 bind .html.x <Motion> {
    set url [string trim [.html href %x %y] {{}}]
    if {[string length $url]} {
        .html configure -cursor hand2
    } else {
        .html configure -cursor xterm
    }
 }

So, the final stage:
 proc script {args} {}
 .html configure -scriptcommand script
 geturl http://www.slashdot.org
----
OK - I've created a package which wraps up this and some more functionality. When my ftp server comes up, I will put it at either:
   * http://tallniel.port5.com/browser.tar.gz
or
   * http://www.tallniel.co.uk/browser.tar.gz
depending which comes up first :-)

The basic usage of the package is:
 package require browser
 pack [scrollbar .vsb -orient vertical -command {.html yview}] -side right -fill y
 pack [browser::browser .html -bg white -yscrollcommand {.vsb set}] \
    -side top -fill both -expand 1
 pack [label .l -bg gray -textvariable ::browser::browser(.html,status)] -side bottom -fill x
 proc updateTitle {var1 var2 op} {
     wm title . $::browser::browser($var2)
 }
 trace variable ::browser::browser(.html,title) w updateTitle
 browser::geturl .html http://slashdot.org

This deals with getting the page and all images (including a rudimentary cache), and handling links etc. It even will handle forms, but this doesn't seem to be working correctly in my Tkhtml build. License is normal BSD/Tcl license. I'll contribute it to tklib once I've polished it up a bit. Requires Tkhtml and http, with the optional addition of Img (recommended). I need to sort out the URL handling as well - may change to the uri package from tcllib, which handles various URLs better. You can add https support if you have TLS, too (see the http package docs).
----
[Category Application], [Tkhtml], [http]