#!/bin/sh
# -*- tcl -*- \
exec wish4.1 -file $0 ${1+"$@"}

#	PASTIME Project
#	Cooperative Research Centre for Advanced Computational Systems
#	COPYRIGHT NOTICE AND DISCLAIMER.
#
#	Copyright (c) 1995 ANU and CSIRO
#	on behalf of the participants in
#	the CRC for Advanced Computational Systems (ACSys)
#
# This software and all associated data and documentation ("Software")
# was developed for research purposes and ACSys does not warrant that 
# it is error free or fit for any purpose.  ACSys disclaims all liability
# for all claims, expenses, losses, damages and costs any user may incur 
# as a result of using, copying or modifying the Software.
#
# You may make copies of the Software but you must include all of this
# notice on any copy.

if {[info tclversion] < 7.5 || $tk_version < 4.1} {
    puts stderr "This library requires Tcl 7.5 and Tk 4.1, this is only Tcl [info tclversion] / Tk $tk_version"
    exit 1
}

lappend auto_path . ;# Allow it to work in the source directory before installation

set wwwhome {}

switch $tcl_platform(platform) {
    macintosh {
	catch {set surfitrc $env(PREF_FOLDER)/SurfIt!RC}
	catch {set pref $env(PREF_FOLDER)/SurfIt!Pref}
    }
    windows {
    }
    unix -
    default {
	catch {set surfitrc $env(HOME)/.surfitrc}
	catch {set pref $env(HOME)/.surfitpref}
	catch {set wwwhome $env(WWW_HOME)}
	if {$wwwhome == {} && [file readable "$env(PWD)/doc/index.html"]} {
	    set wwwhome "file://$env(PWD)/doc/index.html"	;# we're in the source directory
	}
    }
}

### Load Tcl script code

# Invoke the user's preference script.  This allows the user to
# redefine auto_path, for example.

catch {source $surfitrc}

###
### Setup environment
###

### Load dynamic modules

# Load TclX
if {![info exists tclXLibPath]} {
    set tclXLibPath /usr/local/tclX/lib/libtclx[info sharedlibextension]
}
if {[catch {load $tclXLibPath TclX} err]} {
    puts stderr "Extended Tcl unavailable due to:\n$err"
}

# Load BLT
if {![info exists bltLibPath]} {
    set bltLibPath [file dirname [set tk_library]]/libBLT[info sharedlibextension].1
}
if {[catch {load $bltLibPath BLT} err]} {
    puts stderr "tables unavailable due to:\n$err"
}

# Can't use autoloading since packages have initialisation code,
# and we want to be able to override procedure definitions.
# Fortunately, tclX gives us the auto_load_file command
# BUT TclX may not be installed, so provide an alternate implementation

if {[info commands auto_load_file] == {}} {
    proc auto_load_file {f} {
	global auto_path
	set found 0
	foreach p $auto_path {
	    if {$p == "."} {
		set path $f
	    } else {
		set path $p/$f
	    }
	    if {[file readable $path]} {
		set found 1
		uplevel #0 source $path
		break
	    }
	}
	if {!$found} {
	    error "unable to source \"$f\", file not found"
	}
    }
}

puts "sourcing utilities"
auto_load_file utils.tcl
puts "sourcing url"
auto_load_file url.tcl
puts "sourcing prot"
auto_load_file prot.tcl
puts "sourcing cache"
auto_load_file cache.tcl
set htmllib htmllib.tcl
puts "sourcing $htmllib"
auto_load_file $htmllib
HMoptimize
#puts "sourcing HTML extras"
#auto_load_file moretags.tcl
puts "sourcing safe-tk.tcl"
auto_load_file safe-tk.tcl

# Override library routines
rename HMlink_setup surfit_setup_anchor
rename HMwin_install surfit_win_install

# Override the Safe-Tk applet destruction proc
rename interp_delete_slave surfit_interp_delete_slave

puts "sourcing other handlers"
auto_load_file handlers.tcl
puts "sourcing application/x-tcl handler"
auto_load_file applets.tcl
puts "sourcing hypertool handler"
auto_load_file hypetool.tcl
puts "sourcing surfit internals"
auto_load_file internal.tcl
puts "environment ready"

# Now invoke the user's preferences file, if any.
# This allows the user to override any standard definitions.

if {[file readable $pref]} {
    source $pref
}

###
### Window management
###

set surfit_win_num 0

###
### Set up initial windows
###

wm maxsize . [winfo screenwidth .] [winfo screenheight .]
wm title . "SurfIt!"
wm iconname . "SurfIt!"
set surfit(appname) [tk appname surfit]

#
# Preferences for Text widgets
#

option add *Text.height 40 startup
option add *Text.width 80 startup
bind Text <End> {%W yview end}
bind Text <Home> {%W yview 0.0}
bind Text <Next> {%W yview scroll 1 page}
bind Text <Prior> {%W yview scroll -1 page}

set s ""

# Control window

set p [frame $s.ctl-panel]
button $p.quit -text "Quit" -command {destroy .}

button $p.home -text "Home" -command {surfit_create_window $wwwhome}
if {$wwwhome == {}} "$p.home configure -state disabled"
menubutton $p.cache -text "Cache" -relief raised -menu $p.cache.m
menu $p.cache.m -tearoff no
$p.cache.m add command -label "Empty Memory Cache" -command {Cache_flush}
$p.cache.m add command -label "Flush Entire Cache" -command {Cache_expire_all}
menubutton $p.applets -text "Applets" -relief raised -menu $p.applets.m
menu $p.applets.m

# Debugging aid menu

menubutton $p.debug -text "Debug" -relief raised -menu $p.debug.m
menu $p.debug.m
$p.debug.m add command -label $htmllib	-command "auto_load_file $htmllib; HMoptimize"
#$p.debug.m add command -label "extras"	-command {auto_load_file moretags.tcl}
$p.debug.m add command -label "internals"	-command {auto_load_file internal.tcl}
$p.debug.m add command -label "prot.tcl"	-command {auto_load_file prot.tcl}
$p.debug.m add command -label "cache.tcl"	-command {auto_load_file cache.tcl}
$p.debug.m add command -label "handlers.tcl"	-command {auto_load_file handlers.tcl}
$p.debug.m add command -label "applets.tcl"	-command {auto_load_file applets.tcl}
$p.debug.m add command -label "safe-tk.tcl"	-command {auto_load_file safe-tk.tcl}
$p.debug.m add command -label "hypetool.tcl"	-command {auto_load_file hypetool.tcl}
$p.debug.m add command -label "url.tcl"	-command {auto_load_file url.tcl}

button $p.about -text "About..." -command {surfit_create_window http://pastime.anu.edu.au/SurfIt/}

pack $p.quit $p.home -side left -anchor nw
pack $p.debug $p.cache $p.applets -side left -anchor w
pack $p.about -side right -anchor ne

pack $p -side top -fill x

set p [frame $s.open-panel]

button $p.openlab -text "Open New: " -command {
    surfit_create_window $open_vars(.)
}
entry $p.open -textvariable open_vars(.) \
	-relief raised -border 2
bind $p.open <Key-Return> {
    surfit_create_window $open_vars(.)
}
set open_vars(.) {}

pack $p.openlab -side left -anchor nw
pack $p.open -side left -anchor nw -fill both -expand yes
pack $p -side top -fill x -expand yes -anchor sw

# Initial (main) hyperdoc window

update
set main [surfit_create_window]

# Want to position the main window just beneath the control panel
# Need to get the x, y and height of the frame surrounding the control panel
# For now, I'll fudge it for olwm
wm geometry $main =+[expr [winfo rootx .] - 5]+[expr [winfo rooty .] + 5 + [winfo height .]]

# resize the browser control panel to be at least as wide as the main window
update
set height [winfo height $p]
pack propagate $p 0
$p configure -width [max [winfo width .] [winfo width $main]] -height $height

# Optionally load home page
if {$wwwhome != {}} {
    incr surfit_url_history_idx($main.main.text)
    SurfIt_loadURL $wwwhome $main.main.text
}
