#!../tkdot -f

# Viewer for dot files received from Mosaic.  If a node, edge, or
# graph in the dot file has an attribute named "URL" then command
# Mosaic to go to the URL when the object is clicked on.

# Requires that the NCSA httpd server have "AddType application/x-dot dot"
# in its conf/srm.conf, and that the client have "application/x-dot; webdot %s"
# in its $HOME/.mailcap

###### CONFIGURATION #########
# set this to the ffull path name of you Mosaic executable
set mosaic_bin /usr/add-on/pub/lbin/Mosaic

#if you start Mosaic from a wrapper script then set the name here
# otherwise set same as mosaic_bin
set mosaic_sh Mosaic
###### END CONFIGURATION #########

set mosaic_timeout 30

set maxheight 500
set maxwidth 500

option add *activeBackground #bfbfbf
option add *activeForeground #000000
option add *HighlightBackground #bfbfbf
option add *Background #bfbfbf
option add *Foreground #000000
option add *Scrollbar.background #646464
option add *Scrollbar.foreground #bfbfbf
option add *troughColor #646464

#set txC AntiqueWhite4
#set buC AntiqueWhite4
#set bpC AntiqueWhite4
#set eyC AntiqueWhite4
#set scC AntiqueWhite4
#set spC AntiqueWhite4
#set baC AntiqueWhite4
#set bbC AntiqueWhite4
#
#option add *background $txC
#option add *foreground $txC
#option add *troughColor $txC
#
#option add *Button.background $buC
#option add *Menubutton.background $buC
#option add *Menu.background $buC
#
#option add *Button.activeBackground $bpC
#option add *Menubutton.activeBackground $bpC 
#option add *Menu.activeBackground $bpC
#
#option add *Canvas.background $txC
#option add *Frame.background $txC
#option add *Label.background $txC
#option add *Message.background $txC
#
#option add *Entry.background $eyC 
#
#option add *Radiobutton.background $scC
#option add *Listbox.background $scC
#option add *Scrollbar.foreground $scC
#
#option add *Radiobutton.activeBackground $spC
#option add *Listbox.selectBackground $spC
#option add *Entry.selectBackground $spC
#
#option add *Scrollbar.activeForeground $baC
#
#option add *Scrollbar.background $bbC


proc show_about {} {
    toplevel .about 
    message .about.msg \
	-width 400 \
	-text "WebDot, the client - by John.Ellson@att.com\n\nAcknowledgements:\ntcl, tk - John Ousterhout\ngd - Thomas Boutell\ndot - Stephen North, Eleftherios Koutsofios\ntcldot, tkdot - John Ellson, Dayatra Shands"
    button .about.done \
	-text "Exit" \
	-command {destroy .about}
    pack append .about .about.msg {top} .about.done {right}
    wm title .about "About WebDot"
}

proc check_mosaic_pid {mosaic_bin} {
    set pid ""
    set ps [split [exec /bin/ps -xw] \n]
    foreach i $ps {
        if {[string first $mosaic_bin $i] != -1} {
	    scan $i "%d" pid
        }
    }
    return $pid
}

proc show_url {url} {
    upvar #0 mosaic_bin mosaic_bin mosaic_sh mosaic_sh
    set pid [check_mosaic_pid $mosaic_bin]
    if {[string first "http:" $url] < 0 && [string first "file:" $url] < 0} {
	set url "file://localhost[pwd]/$url"
    }
    if {$pid == ""} {
	puts stderr "Starting Mosaic"
        exec $mosaic_sh $url &
    } {
	if [catch {open /tmp/Mosaic.$pid w} f] {
	    puts stderr "Unable to open /tmp/xmosaic.$pid"
	} {
	    puts $f "goto\n$url"
	    close $f
	    exec kill -30 $pid
	}
    }
}

proc scrollEnter {c} {
    upvar #0 tk_library tk_library saveFill saveFill
    set item [string range [lindex [$c gettags current] 0] 1 end]
    set saveFill [lindex [$c itemconfigure 1$item -fill] 4]
    if {! [catch {lindex [$item queryattr URL] 0} url]} {
        if {$url != ""} {
            set name [$item showname]
            regsub -all {\\N} $url $name url
            $c itemconfigure 1$item -fill black -stipple gray25
	    .t configure -state normal
	    .t delete 0.0 end
	    .t insert 0.0 $url
	    .t configure -state disabled
	}
    }
}

proc scrollLeave {c} {
    upvar #0 saveFill  saveFill default_url default_url
    set item [string range [lindex [$c gettags current] 0] 1 end]
    if {! [catch {lindex [$item queryattr URL] 0} url]} {
        if {$url != ""} {
            $c itemconfigure 1$item -fill $saveFill -stipple {}
	    .t configure -state normal
	    .t delete 0.0 end
	    .t insert 0.0 $default_url
	    .t configure -state disabled
	}
    }
}

proc select {c} {
    upvar #0 g g
    set item [string range [lindex [$c gettags current] 0] 1 end]
    if {$item == ""} {set item $g}
    if {! [catch {lindex [$item queryattr URL] 0} url]} {
        set name [$item showname]
        regsub -all {\\N} $url $name url
	show_url $url
    }
}

proc load {c} {
    upvar #0 g g argv argv saveFill saveFill \
        maxheight maxheight maxwidth maxwidth \
	default_url default_url
    set saveFill ""
    catch {$g delete}
    $c delete all

    if {$argv == ""} {
	puts "No dot file supplied on command line. Assuming demo mode."
	cd data
	set argv "[pwd]/poly.dot"
    }
    if {[catch {open $argv r} f]} {
	puts "Error opening $argv"
	exit
    }
    set g [dotread $f]
    close $f
    
    $g layout
    
    eval [$g render]
    
    scan [$g queryattr bb] "{%dp %dp %dp %dp}" ulx uly lrx lry
    set y [if {$lry > $maxheight} {set maxheight} {set lry}]p
    set x [if {$lrx > $maxwidth} {set maxwidth} {set lrx}]p
    $c configure -height $y -width $x \
	-scrollregion [list 0 0 [set lrx]p [set lry]p]
    catch {lindex [$g queryattr URL] 0} default_url
    .t configure -state normal
    .t delete 0.0 end
    .t insert 0.0 $default_url
    .t configure -state disabled
}

wm minsize . 100 100
wm title . "WebDot"
wm iconname . "WebDot"

frame .f 
frame .b
if {[string index [info tclversion] 2] < 4} {
    # what a pain!
    set c [canvas .f.c \
        -xscroll ".b.hsb set" \
        -yscroll ".f.vsb set"
    scrollbar .f.vsb \
        -relief sunken \
        -command "$c yview"
    scrollbar .b.hsb \
        -orient horiz \
        -relief sunken \
        -command "$c xview"
} {
    set c [canvas .f.c \
        -xscrollcommand ".b.hsb set" \
        -yscrollcommand ".f.vsb set"]
    scrollbar .f.vsb \
        -relief sunken \
        -command "$c yview"
    scrollbar .b.hsb \
        -orient horiz \
        -relief sunken \
        -command "$c xview"
}
frame .b.fill \
    -width 20 \
    -height 20
frame .m \
    -relief raised \
    -borderwidth 2
text .t \
    -state disabled \
    -font -Adobe-Helvetica-medium-r-normal--*-140* \
    -height 1 \
    -width 40 \
    -wrap none
menubutton .m.file \
    -font "-*-helvetica-bold-o-normal-*-14-*-iso8859-1" \
    -text "File" \
    -menu .m.file.m \
    -underline 0
menubutton .m.help \
    -font "-*-helvetica-bold-o-normal-*-14-*-iso8859-1" \
    -text "Help" \
    -menu .m.help.m \
    -underline 0
menu .m.file.m
.m.file.m add command \
    -label "Refresh Current..." \
    -underline 0 \
    -command "load $c"
.m.file.m add command \
    -label "Exit Program..." \
    -underline 0 \
    -command exit
menu .m.help.m
.m.help.m add command \
    -label "About" \
    -underline 0 \
    -command {show_about}
.m.help.m add command \
    -label "Help on Webdot, the Client" \
    -command {show_url "http://www.tbu.att.com/webdot_demo/webdot_client.html"}
.m.help.m add command \
    -label "Help on Webdot, the  Server" \
    -command {show_url "http://www.tbu.att.com/webdot_demo/"}

pack append . .m {fillx} .f {expand fill} .b {fillx} .t {fillx}
pack append .f .f.c {left expand fill} .f.vsb {right filly} 
pack append .b .b.hsb {left expand fillx} .b.fill {right}
pack append .m .m.file {left} .m.help {right}

$c bind all <Any-Enter> "scrollEnter $c"
$c bind all <Any-Leave> "scrollLeave $c"

bind $c <1> "select $c"

bind $c <2> "$c scan mark %x %y"
bind $c <B2-Motion> "$c scan dragto %x %y"

load $c
