Updated 2012-04-21 03:57:01 by RLE ▲

GPS: RS inspired me with his COM on! - a tiny web browser code. I decided to extend the idea and make it more general.
 bind . <Escape> {
        exec [file nativename [info nameofexecutable]] $argv0 &
        exit
 }
 proc forceFocus {win} {
        catch {focus -force $win}
 }
 proc setOptions {} {
        option add *Button.pady 0
        option add *Button.padx 1
        option add *Button.borderWidth 1
 }
 proc loadLocation {win} {
        upvar #0 _${win}ar ar

        if {[catch {$ar(htm) navigate $ar(location)} res]} {
                return -code error $res        
        }
 }
 proc linkchanged {win id page} {
        upvar #0 _${win}ar ar

        $win.status config -text $page
 }
 proc buildInterface {win location} {
        upvar #0 _${win}ar ar

        #The default for new instances
        set ar(location) $location

        frame $win -class WippleWobble
        pack [frame $win.controls] -fill x

        pack [button $win.controls.backward -text "<<" \
                -command "\[set ::_${win}ar(htm)] goBack"] -side left
        pack [button $win.controls.forward -text ">>" \
                -command "\[set ::_${win}ar(htm)] goForward"] -side left

        pack [button $win.controls.stop -text "Stop" \
                -command "\[set ::_${win}ar(htm)] stop" -bg firebrick] -side left

        pack [entry $win.controls.e \
                -textvariable ::_${win}ar(location)] \
                -side left -fill x -expand 1

        bind $win.controls.e <Return> [list loadLocation $win]


        pack [button $win.controls.go -text Go \
                -command [list loadLocation $win] -bg darkgreen -fg white] -side left

        set htm [optcl::new -window $win.htm Shell.Explorer.2]
        pack $win.htm -fill both -side top -expand 1
        set ar(htm) $htm

        pack [label $win.status] -side bottom -anchor w

        optcl::bind $htm StatusTextChange [list linkchanged $win]

        $htm navigate $ar(location)        

        return $win
 } 

 proc debug {tok} {
        upvar #0 _${tok}ar ar

        console show
        tlview::viewtype [ optcl::class $ar(htm)]
 }

 proc main {argc argv} {
        wm title . "WippleWobble"
        package require optcl

        setOptions
        pack [frame .master] -fill both -expand 1

        #pass an empty parent for the . window
        pack [buildInterface .master.1 "www.google.com"] -side top -fill both -expand 1
        pack [buildInterface .master.2 "www.yahoo.com"] -side bottom -fill both -expand 1
        pack [button .debug -text Debug -command {debug .master.1}] -side bottom


        bind all <Enter> {forceFocus %W}
        bind all <ButtonPress-1> {forceFocus %W}
 }
 main $::argc $::argv

Category Internet