#!/bin/sh
# \
	exec wish "$0" "$@"
#
# Name
#
#   install
#
# Purpose
#
#   Install the components of tkWorld.
#
#---------------------------------------------------------------------

# Define the application's global option database.
option clear
option add *borderWidth 1
option add *troughColor #d9d9d9
option add *selectBackground #000000
option add *selectForeground #ffffff
option add *activeBackground #d9d9d9
option add *activeForeground #000000
option add *Entry.background #ffffff
option add *Entry.foreground #000000

namespace eval install {
    variable install

    # Define some odds and ends that will be used by the application
    # that will change as time goes on.
    set install(version) "1.1.3"
    set install(copyright) "Copyright (C) 1996-2000 Wesley H. Bailey"
    set install(www) "http://www.tkworld.org"
    set install(ostype) [string tolower $tcl_platform(platform)]
    
    # Define the home directory for install.
    set install(home) [pwd]
    
    # Setup the install script directory structure based on the home
    # directory.
    set install(lib_dir) [file join $install(home) lib]
    set install(image_dir) [file join $install(lib_dir) images]

    # Define the default installation and link directories.
    set install(src_dir) "/usr/local/src"
    set install(link_dir) "/usr/local/bin"

    # Define the tkWorld user to install the app under.
    if [info exists env(USER)] {
	set install(user) $env(USER)
    } elseif [info exists env(USERNAME)] {
	set install(user) $env(USERNAME)
    } elseif [info exists env(LOGNAME)] {
	set install(user) $env(LOGNAME)
    } else {
	set install(user) unknown
    }

    # Define the window characteristics based on the install
    # operating system.
    switch $install(ostype) {
	windows {
	    set install(font.title) {helvetica 12 bold}
	    set install(font.message) {helvetica 10}
	    set install(font.info) {helvetica 10 italic}
	    set install(font.contact) {helvetica 10}
	}
	default {
	    set install(font.title) {helvetica 14 bold}
	    set install(font.message) {helvetica 12}
	    set install(font.info) {helvetica 12 italic}
	    set install(font.contact) {helvetica 12}
	}
    }
}

# install::test --
#
#   Method to test to the tkWorld installation.
#
# Args
#
#   None.
#
# Returns
#
#   None.

proc install::test { } {
    variable install

    # Execute the tkWorld application in the background.
    if [catch {exec [file join $install(link_dir) tkworld] &} errmsg] {
	update idletasks
	install::log "Error: Installation test failed\n$errmsg"
	bell; install::abort
    }

    # Make sure the Test Install button rises back up.
    update idletasks
}

# install::exit --
#
#   Method to exit the tkWorld installer. 
#
# Args
#
#   None.
#
# Returns
#
#   None.

proc install::exit { } {
    variable install

    destroy .
}

# install::log --
#
#   Insert a message in the application's Log Window.
#
# Args
#
#   msg - The message to display.
#
# Returns
#
#   None.

proc install::log { msg } {
    variable install

    # Insert the message in the Log Window.
    $install(log_window) insert end "$msg\n"

    # Move to the end of the LW.
    $install(log_window) see end
}

# install::abort --
#
#   Method for exiting the application that waits for the user
#   to click on the Exit button.
#
# Args
#
#   None.
#
# Returns
#
#   None.

proc install::abort { } {
    variable install

    install::end

    # Disable the install button.
    $install(button.install) configure -state disabled

    # Set it up so when the user clicks on exit, the app is gone
    # without having to rely on returning the right spot and not
    # executing any more commands.
    tkwait window .
}

# install::appfile --
#
#   Method to copy a file to a source directory, then change
#   its owner and permissions.
#
# Args
#
#   p_file  - File to copy from the distribution.
#   p_src   - Directory to copy the file to.
#
# Returns
#
#   None.

proc install::appfile { p_file p_src {p_perm 0644} } {
    variable install

    # Copy the file first.
    if [catch {file copy $p_file $p_src} errmsg] {
	install::log "Error: Failed to copy $p_file to $p_src\n$errmsg"
	bell; install::abort
    }

    # Set the current working file to the successfully copied file.
    set p_file [file join $p_src [file tail $p_file]]

    # Change the owner of the copied file.
    if [catch {file attributes $p_file -owner $install(user)} errmsg] {
	bell
	install::log "Error: Failed to set owner on file $p_file\n$errmsg"
	bell; install::abort
    }

    # Now change the permissions and go home.
    if [catch {file attributes $p_file -permissions $p_perm} errmsg] {
	install::log "Error: Failed to set permissions of $p_perm\
		on file $p_file\n$errmsg"
	bell; install::abort
    }
}

# install::appdir --
#
#   Method to create a directory in the source hierarchy.
#
# Args
#
#   p_dir   - Directory to create in the source hierarchy.
#
# Returns
#
#   None.

proc install::appdir { p_dir {p_perm 0755} } {
    variable install

    # Create the directory first.
    if [catch {file mkdir $p_dir} errmsg] {
	install::log "Error: Failed to create directory $p_dir\n$errmsg"
	bell; install::abort
    }

    # Change the owner of the new directory.
    if [catch {file attributes $p_dir -owner $install(user)} errmsg] {
	install::log "Error: Failed to set owner on $p_dir\n$errmsg"
	bell; install::abort
    }

    # Now change the permissions and go home.
    if [catch {file attributes $p_dir -permissions $p_perm} errmsg] {
	install::log "Error: Failed to set permissions of $p_perm\
		on $p_dir\n$errmsg"
	bell; install::abort
    }
}

# install::end --
#
#   Method to end the installation.
#
# Args
#
#   None.
#
# Returns
#
#   None.

proc install::end { } {
    variable install

    # Tell the user when they stopped the installation.
    install::log "\nInstallation completed on [clock format [clock seconds]]"

    # Change the Cancel button to an Exit button.
    $install(button.cancel) configure -text "Exit"

    bell
}

# install::install --
#
#   Method to install the components of the tkWorld distribution.
#
# Args
#
#   None.
#
# Returns
#
#   None.

proc install::install { } {
    variable install

    # First test the OS if we already haven't, then see if we already
    # built the Log Window.  Otherwise reset the colors of the entries
    # and clear the Log Window.

    if ![winfo exists .s3] {
	# If not unix, then send a message to the user and setup
	# for exit.
	switch $install(ostype) {
	    windows -
	    macintosh {
		install::log "Note: Installation is not necessary on this\
			platform.\nInvoke the Tcl script tkWorld.tcl\
			to run the application"
		bell; install::abort
	    }
	}

	# Now that the user decided to install the application, open
	# up the Log Window
	grid [frame .s3 \
		-relief sunken \
		-width 2 \
		-height 2 \
		-bd 4] \
		-row 5 \
		-padx 0 \
		-pady 0 \
		-sticky ew
	grid .bot \
		-row 6 \
		-padx 2 \
		-pady 5 \
		-sticky news

	# Add the LW page up/down buttons so the user can navigate
	# the text in the Log Window.
	button .buttons.pageup \
		-text "Page Up" \
		-width 8 \
		-command [list $install::install(log_window) \
		yview scroll -1 pages]
	button .buttons.pagedown \
		-text "Page Down" \
		-width 8 \
		-command [list $install::install(log_window) \
		yview scroll +1 pages]
	pack .buttons.pageup .buttons.pagedown \
		-side left \
		-padx 5 \
		-pady 5
    } else {
	$install(log_window) delete 1.0 end

	# Reset the colors of the entries.
	foreach x "src_dir link_dir" {
	    $install(entry.$x) configure -bg white
	}
    }

    # Check to make sure the src and link directories actually exist
    # and that the current user can write to them.

    install::log "tkWorld installation started on\
	    [clock format [clock seconds]]\n\nChecking source\
	    existence and permissions..."

    foreach x "src_dir link_dir" {
	if ![file isdirectory $install($x)] {
	    install::log "Error: Directory $install($x) does not exist."
	    $install(entry.$x) configure -bg yellow
	    focus $install(entry.$x)
	    bell; return
	}
	if ![file writable $install($x)] {
	    install::log "Error: Cannot create files in directory\
		    $install($x).\nPlease select another directory"
	    $install(entry.$x) configure -bg yellow
	    focus $install(entry.$x)
	    bell; return
	}
    }

    install::log "Sources exist with write permissions..."

    # Now check for dependencies and display a message.
    install::log "Checking dependencies..."

    # Check if an installation exists in the desired directory.
    if [file isdirectory [file join $install(src_dir) tkWorld]] {
	bell
	set overwrite [tk_messageBox \
		-type yesno \
		-default yes \
		-icon question \
		-title "Previous Installation Found" \
		-message "Overwrite previous installation in\
		$install(src_dir)?"]
	if {$overwrite == "no"} {
	    install::log "Previous installation found...\nInstallation\
		    cancelled by user..."
	    bell; install::abort
	}
	unset overwrite
    }
    
    # Moving forward with new installation or overwriting a
    # previous install.
    install::log "Creating new tkWorld installation..."
    set install(src_dir) [file join $install(src_dir) tkWorld]
    file delete -force $install(src_dir)
    file delete -force [file join $install(link_dir) tkworld]

    # Create the tkWorld directory in the src directory.
    install::log "Creating tkWorld directory in source directory..."
    install::appdir $install(src_dir)
    install::log "tkWorld directory created..."

    # Create the object library directory.
    install::log "Creating the object library...\n"
    install::appfile tkWorld.tcl $install(src_dir) 0755
    install::log "tkWorld.tcl"
    install::appdir [file join $install(src_dir) lib]
    install::log "lib"

    # Create the components of the object library.
    foreach x "images tcl registry" {
	set src_dir [file join $install(src_dir) lib $x]
	set from_dir [file join lib $x]
	install::appdir $src_dir
	install::log "|-- $x"
	foreach y [glob [file join $from_dir *.*]] {
	    install::appfile $y $src_dir
	    install::log "|   |-- [file tail $y]"
	}
	if {$x == "images"} {
	    set prv_src $src_dir 
	    set prv_from $from_dir
	    set src_dir [file join $prv_src toolbar]
	    set from_dir [file join $prv_from toolbar]
	    install::log "|   |-- toolbar"
	    install::appdir $src_dir
	    foreach y [glob [file join $from_dir *.*]] {
		install::appfile $y $src_dir
		install::log "|   |   |-- [file tail $y]"
	    }
	    set src_dir [file join $prv_src working]
	    set from_dir [file join $prv_from working]
	    install::log "|   |-- working"
	    install::appdir $src_dir
	    foreach y [glob [file join $from_dir *.*]] {
		install::appfile $y $src_dir
		install::log "|   |   |-- [file tail $y]"
	    }
	    set src_dir [file join $prv_src cleanup]
	    set from_dir [file join $prv_from cleanup]
	    install::log "|   |-- cleanup"
	    install::appdir $src_dir
	    foreach y [glob [file join $from_dir *.*]] {
		install::appfile $y $src_dir
		install::log "|   |   |-- [file tail $y]"
	    }
	}
    }

    # Let the user know the application objects made it okay.
    install::log "\nApplication object library installed successfully..."

    # Now create the link.
    if [catch {exec ln -s [file join $install(src_dir) tkWorld.tcl] \
	    [file join $install(link_dir) tkworld]} errmsg] {
	install::log "Error: Cannot create symbolic link to\
		tkWorld.tcl from $install(link_dir)\n$errmsg"
	bell; install::abort
    }

    install::log "Symbolic tkworld created successfully in\
	    $install(link_dir)...\n"

    # Now let the user test tkWorld out to see if it
    # installed correctly.
    $install(button.install) configure \
	    -state active \
	    -text "Test Install" \
	    -command install::test
    install::log "Click on the Test Install button above to test\
	    the tkWorld installation."

    # If everything runs okay, then say goodbye!
    install::end
}

# install::startup --
#
#   Method to build the initial tkWorld Installer GUI.
#
# Args
#
#   None.
#
# Returns
#
#   None.

proc install::startup { } {
    variable install

    # Create the elements of the placard.
    set img [image create photo \
	    -file [file join $install(image_dir) tkWorld.gif]]

    # Build the top with the messages and icon.
    set f [frame .top]
    label $f.icon \
	    -image $img
    label $f.title \
	    -width 35 \
	    -text "tkWorld Installer-$install(version)" \
	    -foreground red \
	    -font $install(font.title)
    label $f.info \
	    -width 35 \
	    -text "$install(copyright)" \
	    -font $install(font.info)
    label $f.message \
	    -width 35 \
	    -text "For installation help, consult the documentation at\n\
	    $install(www)/help\n" \
	    -font $install(font.message) \
	    -anchor w
    grid $f.icon \
	    -row 0 \
	    -column 0 \
	    -rowspan 3 \
	    -padx 5 \
	    -pady 2 \
	    -sticky n
    grid $f.title \
	    -row 0 \
	    -column 1 \
	    -padx 10 \
	    -sticky new
    grid $f.info \
	    -row 1 \
	    -column 1 \
	    -padx 5 \
	    -pady 2 \
	    -sticky ew
    grid $f.message \
	    -row 2 \
	    -column 1 \
	    -padx 5 \
	    -pady 5 \
	    -sticky w

    # Build the middle section with the directory selections.
    set f [frame .dir]
    label $f.label_src_dir \
	    -text "Select a directory to install the tkWorld\
	    application directory in:" \
	    -anchor w
    set install(entry.src_dir) [entry $f.entry_src_dir \
	    -textvariable install::install(src_dir) \
	    -width 20]
    frame $f.spacer \
	    -height 10
    label $f.label_link_dir \
	    -text "Select a directory to create the tkworld\
	    link from:" \
	    -anchor w
    set install(entry.link_dir) [entry $f.entry_link_dir \
	    -textvariable install::install(link_dir) \
	    -width 20]
    pack $f.label_src_dir $f.entry_src_dir $f.spacer $f.label_link_dir \
	    $f.entry_link_dir \
	    -side top \
	    -fill x \
	    -padx 5 \
	    -pady 0

    # Build the current bottom section with the buttons.
    set f [frame .buttons]
    set install(button.install) [button $f.install \
	    -text Install \
	    -width 8 \
	    -command install::install]
    set install(button.cancel) [button $f.cancel \
	    -text Cancel \
	    -width 8 \
	    -command install::exit]
    pack $f.install \
	    -side left \
	    -padx 5 \
	    -pady 5
    pack $f.cancel \
	    -side right \
	    -padx 5 \
	    -pady 5

    # Build the install Log Window.
    set f [frame .bot]
    scrollbar $f.yscrollbar \
	    -command "$f.log_window yview" \
	    -orient vertical
    scrollbar $f.xscrollbar \
	    -command "$f.log_window xview" \
	    -orient horizontal
    set install(log_window) [text $f.log_window \
	    -wrap none \
	    -width 56 \
	    -height 15 \
	    -bg #ffffff \
	    -yscrollcommand [list $f.yscrollbar set] \
	    -xscrollcommand [list $f.xscrollbar set]]
    grid $f.log_window $f.yscrollbar \
	    -row 0 \
	    -sticky news \
	    -padx 0 \
	    -pady 0
    grid $f.xscrollbar \
	    -row 1 \
	    -sticky ew \
	    -padx 0 \
	    -pady 1

    # Now pack up each part of the GUI.
    grid .top \
	    -row 0 \
	    -padx 5 \
	    -pady 5 \
	    -sticky news
    grid [frame .s1 \
	    -relief sunken \
	    -width 2 \
	    -height 2 \
	    -bd 4] \
	    -row 1 \
	    -padx 0 \
	    -pady 0 \
	    -sticky ew
    grid .dir \
	    -row 2 \
	    -padx 5 \
	    -pady 5 \
	    -sticky news
    grid [frame .s2 \
	    -relief sunken \
	    -width 2 \
	    -height 2 \
	    -bd 4] \
	    -row 3 \
	    -padx 0 \
	    -pady 0 \
	    -sticky ew
    grid .buttons \
	    -row 4 \
	    -padx 5 \
	    -pady 0 \
	    -sticky news

    update idletasks

    # Configure the window manager for unix.
    switch $install(ostype) {
	unix {
	    wm title . "tkWorld Installer"
	    wm resizable . 0 0
	}
    }
}

# All the code and this is all that gets executed!
install::startup