#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

#=========================================================================
#                              SCOUT.
#ADAPTED FROM THE HV FILE VIEWER INCLUDED IN THE htmlwidget PACKAGE.
#USES THE ComboBox FROM THE BWidget EXTENSION PACKAGE, BUT COULD EASILY
#USE SOMETHING ELSE.
#ERROR-HANDLING IS VIRTUALLY NON-EXISTENT. THAT'S BECAUSE I'M NEW TO TCL,
#AND A BODGER BY NATURE!
#FEEL FREE TO HACK IT INTO SOME SEMBLANCE OF PROPER CODING!

#=========================================================================

# Make sure the html widget, and other things, are loaded into
# our interpreter
#

lappend auto_path /usr/lib/BWidget-1.2

package require BWidget
package require Img
package require Tkhtml
package require http 2.0
package require FTP 1.2


set Getter ""
set now 0
set latest 0
set Surfing 0
set Target ""
#ftp port
set port "21"
#anonymous login
set usern "anonymous"
#e-mail address
set passw "****@******"
#directory to download to
set dest "/usr/download"
    

# The HtmlTraceMask only works if the widget was compiled with
# the -DDEBUG=1 command-line option.  "file" is the name of the
#first HTML file to be loaded.

set HtmlTraceMask 0
set file {}
foreach a $argv {
    if {[regexp {^debug=} $a]} {
        scan $a "debug=0x%x" HtmlTraceMask
    } else {
        set file $a
    }
}

# These images are used in place of GIFs or of form elements
#
image create photo biggray -data {
    R0lGODdhPAA+APAAALi4uAAAACwAAAAAPAA+AAACQISPqcvtD6OctNqLs968+w+G4kiW5omm
    6sq27gvH8kzX9o3n+s73/g8MCofEovGITCqXzKbzCY1Kp9Sq9YrNFgsAO///
}
image create photo smgray -data {
    R0lGODdhOAAYAPAAALi4uAAAACwAAAAAOAAYAAACI4SPqcvtD6OctNqLs968+w+G4kiW5omm
    6sq27gvH8kzX9m0VADv/
}
image create photo nogifbig -data {
    R0lGODdhJAAkAPEAAACQkADQ0PgAAAAAACwAAAAAJAAkAAACmISPqcsQD6OcdJqKM71PeK15
    AsSJH0iZY1CqqKSurfsGsex08XuTuU7L9HywHWZILAaVJssvgoREk5PolFo1XrHZ29IZ8oo0
    HKEYVDYbyc/jFhz2otvdcyZdF68qeKh2DZd3AtS0QWcDSDgWKJXY+MXS9qY4+JA2+Vho+YPp
    FzSjiTIEWslDQ1rDhPOY2sXVOgeb2kBbu1AAADv/
}
image create photo nogifsm -data {
    R0lGODdhEAAQAPEAAACQkADQ0PgAAAAAACwAAAAAEAAQAAACNISPacHtD4IQz80QJ60as25d
    3idKZdR0IIOm2ta0Lhw/Lz2S1JqvK8ozbTKlEIVYceWSjwIAO///
}


# Construct the main window
#
frame .mbar -bd 2 -relief raised
pack .mbar -side top -fill x
menubutton .mbar.file -text File -underline 0 -menu .mbar.file.m
pack .mbar.file -side left -padx 5
set m [menu .mbar.file.m]
$m add command -label Open -underline 0 -command Load
$m add command -label Refresh -underline 0 -command Refresh
$m add separator
$m add command -label Exit -underline 1 -command exit

menubutton .mbar.view -text View -underline 0 -menu .mbar.view.m
pack .mbar.view -side left -padx 5
set m [menu .mbar.view.m]
set underlineHyper 0
$m add checkbutton -label {Underline Hyperlinks} -variable underlineHyper
trace variable underlineHyper w ChangeUnderline

proc ChangeUnderline args {
    global underlineHyper
    .h.h config -underlinehyperlinks $underlineHyper
}
set showTableStruct 0
$m add checkbutton -label {Show Table Structure} -variable showTableStruct
trace variable showTableStruct w ShowTableStruct

proc ShowTableStruct args {
    global showTableStruct HtmlTraceMask
    if {$showTableStruct} {
        set HtmlTraceMask [expr {$HtmlTraceMask|0x8}]
        .h.h config -tablerelief flat
    } else {
        set HtmlTraceMask [expr {$HtmlTraceMask&~0x8}]
        .h.h config -tablerelief raised
    }
    Refresh
}
set showImages 1
$m add checkbutton -label {Show Images} -variable showImages
trace variable showImages w Refresh


frame .g  -borderwidth 5 -relief ridge
pack .g -anchor n -fill x -side top
button .g.back  -command Reverse -padx 5 -state disabled -text Back
pack .g.back -ipadx 15 -side left
button .g.forw  -command Advance -state disabled -text Forward
pack .g.forw -anchor n -side left
ComboBox .g.ee -command "Load2" -entrybg #ffffff -modifycmd "Load2"\
        -textvariable Getter -values {http://localhost/} -width 25
button .g.b3  -command Books -text Bookmarks
pack .g.b3 -anchor n -padx 5 -side right
pack .g.ee  -fill x -pady 3 -side top



frame .h
pack .h -side top -fill both -expand 1
html .h.h \
        -yscrollcommand {.h.vsb set} \
        -xscrollcommand {.f2.hsb set} \
        -padx 5 \
        -pady 9 \
        -formcommand FormCmd \
        -imagecommand ImageCmd \
        -scriptcommand ScriptCmd \
        -appletcommand AppletCmd \
        -hyperlinkcommand HyperCmnd \
        -underlinehyperlinks 0 \
        -bg white -tablerelief raised \
        -unvisitedcolor blue\
        

frame .sta  -borderwidth 3 -relief ridge
pack .sta  -fill x  -side bottom
entry .sta.l -text "Status Line" -textvariable Message
pack .sta.l -anchor w -fill x -padx 10 -side top



# If the tracemask is not 0, then draw the outline of all
# tables as a blank line, not a 3D relief.
#
if {$HtmlTraceMask} {
    .h.h config -tablerelief flat
}




# A font chooser routine.
#
# .h.h config -fontcommand pickFont
proc pickFont {size attrs} {
    puts "FontCmd: $size $attrs"
    set a [expr {-1<[lsearch $attrs fixed]?{courier}:{charter}}]
    set b [expr {-1<[lsearch $attrs italic]?{italic}:{roman}}]
    set c [expr {-1<[lsearch $attrs bold]?{bold}:{normal}}]
    set d [expr {int(12*pow(1.2,$size-4))}]
    list $a $d $b $c
}

# This routine is called for each form element
#
proc FormCmd {n cmd args} {
    # puts "FormCmd: $n $cmd $args"
    switch $cmd {
        select -
        textarea -
        input {
            set w [lindex $args 0]
            label $w -image nogifsm
        }
    }
}



# This routine is called for every <IMG> markup
#

proc ImageCmd {args} {
    global OldImages Images showImages Surfing
    if {!$showImages} {
        return smgray
    }
    set fn [lindex $args 0]
    if {[info exists OldImages($fn)]} {
        set Images($fn) $OldImages($fn)
        unset OldImages($fn)
        return $Images($fn)
    }
    global Message
    set Message "Downloading $fn"
    
    set b $fn
    set a [file tail $fn]
    set fn "./"
    append fn $a
    
    #if Surfing = true.. download image... if false.. get image from cache
    
    if {$Surfing} {
        Getafile $b $fn
    }
    
    if {[catch {image create photo -file $fn} img]} {
        return smgray
    }
    if {[image width $img]*[image height $img]>20000} {
        global BigImages
        set b [image create photo -width [image width $img] \
                -height [image height $img]]
        set BigImages($b) $img
        set img $b
        after idle "MoveBigImage $b"
    }
    set Images($fn) $img
    return $img
}


proc MoveBigImage b {
    global BigImages
    if {![info exists BigImages($b)]} return
    $b copy $BigImages($b)
    image delete $BigImages($b)
    unset BigImages($b)
    update
}


# This routine is called for every <SCRIPT> markup.. Not yet implemented
#
proc ScriptCmd {args} {
    # puts "ScriptCmd: $args"
}

# This routine is called for every <APPLET> markup
#
proc AppletCmd {w arglist} {
    # puts "AppletCmd: w=$w arglist=$arglist"
    label $w -text "The Applet $w" -bd 2 -relief raised
}

# This procedure is called when the user clicks on a hyperlink.
# See the "bind .h.h.x" below for the binding that invokes this
# procedure
#
proc HrefBinding {x y} {
    set new [.h.h href $x $y]
    if {$new!=""} {
        global LastFile Getter hist now latest

        set Getter [string trim $new "{}"]
        lappend hist $Getter
        incr latest
        set now $latest
        SetButs $now $latest
        Load2
        
    }
}
bind .h.h.x <1> {HrefBinding %x %y}

# Pack the HTML widget into the main screen.
#
pack .h.h -side left -fill both -expand 1
scrollbar .h.vsb -orient vertical -command {.h.h yview}
pack .h.vsb -side left -fill y

frame .f2
pack .f2 -side top -fill x
frame .f2.sp -width [winfo reqwidth .h.vsb] -bd 2 -relief raised
pack .f2.sp -side right -fill y
scrollbar .f2.hsb -orient horizontal -command {.h.h xview}
pack .f2.hsb -side top -fill x


# This procedure is called when the user selects the File/Open
# menu option.
#
set lastDir [pwd]
proc Load {} {
    set filetypes {
        {{Html Files} {.html .htm}}
        {{All Files} *}
    }
    global lastDir htmltext
    set f [tk_getOpenFile -initialdir $lastDir -filetypes $filetypes]
    if {$f!=""} {
        LoadFile $f
        set lastDir [file dirname $f]
    }
}

proc Load2 {} {
    global Getter Message Surfing now latest
    
    set Surfing 1
    set Message "Downloading $Getter"
    
    #if url begins with 'ftp'.. do an ftp download
    
    set typ [string range $Getter 0 2]
    if {$typ == "ftp"} {
        Eftpe $Getter
    } else  {
        
        #if url points to a filetype which we want.. do an http download..
        #otherwise download to cache, and display
        
        set bit [file extension $Getter]
        switch -glob -- $bit {
            .tar     {Goget $Getter}
            .tgz     {Goget $Getter}
            .gz      {Goget $Getter}
            .rpm     {Goget $Getter}
            .zip     {Goget $Getter}
            default  {
                
                #create a cache directory.. save url where we can get it later
                
                set now $latest
                set dirc [makecache]
                cd $dirc
                set bass $dirc
                append bass "/place"
                
                if {[catch {open $bass w} fp]} {
                    tk_messageBox -icon error -message $fp -type ok
                    return {}
                } else {
                    puts -nonewline $fp $Getter
                    close $fp
                }
                
                Getafile $Getter "./index.html"
                
                set Message "Parsing Html"
                Clear
                LoadFile "./index.html"
                set Message "Document Done"
                set Surfing 0
                ClearOldImages
            }
        }
    }
}

proc Goget  {toget} {    
    set d "/usr/download"
    cd $d
    set n [file tail $toget]
    Getafile $toget $n
}


proc makecache {} {
    global now
    set d "~/.Scache/$now"
    file mkdir $d
    return $d
}


proc Books {} {
    global Getter
    set Getter "http://localhost/doc/bookmarks.html"
    Load2
}


# Copy a URL to a file..Doesn't handle redirects yet

proc Getafile { url file {chunk 4096} } {
    set out [open $file w]
    http::config -useragent "Mozilla/2.0"
    set token [http::geturl $url -channel $out -blocksize $chunk]
    close $out
}


proc Eftpe {inpt} {
    global Target usern passw dest port
    
    catch {destroy .hi}
    toplevel .hi
    
    frame .hi.x -borderwidth 3 -relief ridge
    pack .hi.x -fill x -side top
    entry .hi.x.en -background #e8eef8 -textvariable Target
    pack .hi.x.en -fill x -padx 30 -pady 10
    frame .hi.z
    pack .hi.z -expand true -fill both -padx 25 -side top
    text .hi.z.te -background #fffffa -yscrollcommand ".hi.z.ud set"
    pack .hi.z.te -expand true -fill both -pady 10 -side top
    scrollbar .hi.z.ud -command ".hi.z.te yview"
    pack .hi.z.ud -before .hi.z.te -fill y -pady 10 -side right
    frame .hi.y -borderwidth 3 -relief ridge
    pack .hi.y -fill x -side bottom
    button .hi.y.cancel -text Start -command Fetchit
    pack .hi.y.cancel -pady 10 -side top
    
    
    
    
    .hi.z.te tag configure error -foreground red
    .hi.z.te tag configure data -foreground brown
    .hi.z.te tag configure control -foreground blue
    .hi.z.te tag configure header -foreground white -background black
    
    set Target $inpt
    
    # overwrite default ftp_lib display message procedure
    namespace eval FTP {
        proc DisplayMsg {msg {state ""}} {
            
            .hi.z.te configure -state normal
            switch $state {
                data		{.hi.z.te insert end "$msg\n" data}
                control	{.hi.z.te insert end "$msg\n" control}
                error		{.hi.z.te insert end "$msg\n" error}
                header	{.hi.z.te insert end "$msg\n" header}
                default 	{.hi.z.te insert end "$msg\n"}
            }
            .hi.z.te configure -state disabled
            .hi.z.te see end
            update idletasks
        }
    }
    
    
    proc Fetchit {} {
        global Target usern passw dest port
        
        set fname [file tail $Target]
        set ftemp [file split $Target]
        set fserver [lindex $ftemp 1]
        set fdir "/"
        set count 2
        while 1 {
            set part [lindex $ftemp $count]
            if {$part == $fname} {
                break
            }
            set fdir [file join $fdir $part]
            incr count
        }
        #Next three lines are for debug/checking
        FTP::DisplayMsg $fserver data
        FTP::DisplayMsg $fdir data
        FTP::DisplayMsg $fname data
        
        if [FTP::Open $fserver $usern $passw -port $port -blocksize 8196 -timeout 60] {
            if [FTP::Cd $fdir] {
                FTP::Get $fname $dest
            }
            FTP::Close
        }
        
        destroy .hi
    }
    
    
}

#set state of forward/back buttons according to where we are at the moment

proc SetButs {place end} {
    if {$place == "0"} {
        .g.back config -state disabled
    } else  {
        .g.back config -state normal
    }
    if {$place == $end} {
        .g.forw config -state disabled
    } else  {
        .g.forw config -state normal
    }
}

#backup through cache

proc Reverse {} {
    global Getter now latest Surfing
    
    incr now -1
    
    #get the url belonging to this site, so that html widget can make
    #relative url's correctly
    
    set d "~/.Scache/$now/place"
    set Getter [ReadFile $d]
    SetButs $now $latest
    cd "~/.Scache/$now"
    set Surfing 0
    LoadFile "./index.html"
}

#as Reverse.. but forward through cache

proc Advance {} {
    global Getter now latest
    incr now
    set d "~/.Scache/$now/place"
    set Getter [ReadFile $d]
    SetButs $now $latest
    cd "~/.Scache/$now"
    set Surfing 0
    LoadFile "./index.html"
}


# Clear the screen.
#

proc Clear {} {
    global Images OldImages hotkey
    if {[winfo exists .fs.h]} {set w .fs.h} {set w .h.h}
    $w clear
    catch {unset hotkey}
    ClearBigImages
    ClearOldImages
    foreach fn [array names Images] {
        set OldImages($fn) $Images($fn)
    }
    catch {unset Images}
}
proc ClearOldImages {} {
    global OldImages
    foreach fn [array names OldImages] {
        image delete $OldImages($fn)
    }
    catch {unset OldImages}
}
proc ClearBigImages {} {
    global BigImages
    foreach b [array names BigImages] {
        image delete $BigImages($b)
    }
    catch {unset BigImages}
}

# Read a file
#
proc ReadFile {name} {
    if {[catch {open $name r} fp]} {
        tk_messageBox -icon error -message $fp -type ok
        return {}
    } else {
        fconfigure $fp -translation binary
        set r [read $fp [file size $name]]
        close $fp
        return $r
    }
}

# Load a file into the HTML widget
#
proc LoadFile {name} {
    global Getter
    set html [ReadFile $name]
    if {$html==""} return
    Clear
    global LastFile
    set LastFile $name
    .h.h config -base $Getter
    .h.h parse $html
    ClearOldImages
}

# Refresh the current file.
#
proc Refresh {args} {
    global LastFile Surfing
    if {![info exists LastFile]} return
    set Surfing 0
    LoadFile $LastFile
}

# If an argument was specified, read it into the HTML widget.
#
update
if {$file!=""} {
    LoadFile $file
}


# This binding changes the cursor when the mouse moves over
# top of a hyperlink.
#
bind HtmlClip <Motion> {
    set parent [winfo parent %W]
    set url [$parent href %x %y]
    if {[string length $url] > 0} {
        $parent configure -cursor hand2
        set Message $url
    } else {
        $parent configure -cursor {}
    }
}


