#!/bin/sh
# Note that lines preceeded by a comment ending in a backslash are interpreted
# by the shell only, not by tksipp.
# ... \
TSIPPwb=`echo $0 | sed 's,/INSTALL,,'`; export TSIPPwb
# ... \
LD_LIBRARY_PATH=$TSIPPwb/lib;           export LD_LIBRARY_PATH
# ... \
TCL_LIBRARY=$TSIPPwb/lib;               export TCL_LIBRARY
# ... \
PATH=$TSIPPwb/bin:$PATH;                export PATH
# ... \
exec tksipp "$0" "$@"

# ----------------------------------------------------------------------
#  INSTALLATION PROGRAM
# ----------------------------------------------------------------------
#  Effective Tcl/Tk Programming
#    Mark Harrison, DSC Communications Corp.
#    Michael McLennan, Bell Labs Innovations for Lucent Technologies
#    Addison-Wesley Professional Computing Series
# ======================================================================
#  Copyright (c) 1996-1997  Lucent Technologies Inc. and Mark Harrison
# ======================================================================
#  History:
#    09 May 01 - pdw - Modified for the TSIPP Work Bench
# ======================================================================

set progName TSIPPwb
regsub $progName [file tail [pwd]] {} progVersion

option add *selectColor ForestGreen startupFile
option add *Entry.background white startupFile
option add *Checkbutton.font \
    -*-helvetica-medium-r-normal-*-*-120-* startupFile

if {![file isdirectory [file join lib scripts]]} {
    cd [file dirname [info script]]
}
cd $env($progName)
set auto_path [linsert $auto_path 0 lib]
package require Efftcl

email_bug_reports paul.welton@sympatico.ca

wm withdraw .

# -----------------------------------------------------------------------------
# install_prog --
#
#       This procedure copies $progName from the installation directory to
#       the specified destination directory, and fixes the executables so
#       that they refernce binaries in the specified directory.
#
# Arguments:
#       libDir - Typically /usr/local.  The program will be placed in a
#                subdirectory of this called, in the typical case,
#                /usr/local/$progName$progVersion.  The exception is
#                executables, which will go into $libDir/bin.
#                   
#       binDir - Typically /usr/local.  This is the directory in which
#                the program will expect to find subdirectories "lib" and
#                "bin" which will contain the Tcl core and extensions
#                it needs.
#
# Results:
#       No return value.

proc install_prog {libDir binDir} {

    global progName progVersion

    set installDir [file join $libDir $progName$progVersion]

    if {[file exists $installDir]} {
        set msg "Package \"$progName\" version $progVersion is already installed."
        append msg "\n\nOverwrite?"
        if {![confirm_ask $msg]} {
            return
        }
        file delete -force $installDir
    }

    #  Copy directories to installation directory
    file mkdir $installDir
    foreach subDir {README INSTALL
                    TSIPP_patches classBrowser tcl examples html images} {
        file copy $subDir $installDir
    }
    
    #  If necessary, create a directory for the (program) binaries.
    foreach dir [file join $libDir bin] {
        if {![file exists $dir]} {
            file mkdir $dir
        }
    }
    
    #  Construct the pathname of the final location of the program executable.
    set progExec [file join $libDir bin $progName$progVersion]

    #  Move the program executable to the (program) binary directory.
    file rename [file join $installDir tcl $progName] $progExec
                             
    #  Change the references to the binaries.
    regsubOnFile $progExec "=\\$$progName/"   "=${binDir}/"
        
    #  Change the shell command that extracts the program directory from
    #  the result of "info script" command to a simple assignment.
    regsubOnFile $progExec "${progName}=.*; export $progName"    \
                           "${progName}=${installDir}; export $progName"
    
    #  It is traditional to have a link with the name of the program without
    #  the version number pointing to the active version.  Check if it
    #  already exists, and if it does, then providing that it is a link,
    #  delete it.  Then create a link.
    set linkname [file join $libDir bin $progName]
    if {![catch [list file type $linkname] type] && [string equal $type link]} {
        file delete $linkname
    }
    catch [list exec ln -s $progExec $linkname]
    
    #  Fix the references in the HTML.
    foreach filename [glob [file join $installDir html *.html]] {
        regsubOnFile $filename {HREF="\.\./lib/tsipp3.3b2} "HREF=\"${binDir}/lib/tsipp3.3b2"
    }
    
    return
}

# -----------------------------------------------------------------------------
# install_binaries --
#
#       This procedure copies the binaries needed for $progName to the
#       specified directory.
#
# Arguments:
#       binDir - Typically /usr/local.  This is the directory in which
#                the program will expect to find subdirectories "lib" and
#                "bin" which will contain the Tcl core and extensions
#                it needs.
#
# Results:
#       No return value.

proc install_binaries {binDir} {

    #  If necessary, create the directory for the binaries, including the
    #  subdirectories "lib" and "bin".
    foreach dir [list $binDir                    \
                      [file join $binDir lib]    \
                      [file join $binDir bin]] {
        if {![file exists $dir]} {
            file mkdir $dir
        }
    }

    foreach subDir {lib bin} {
        set targetDir [file join $binDir $subDir]
        foreach item [glob $subDir/*] {
            set fullTarget [file join $targetDir [file tail $item]]
            if {[file exists $fullTarget]} {
                set msg "Directory $fullTarget already exists."
                append msg "\n\nOverwrite?"
                if {![confirm_ask $msg]} {
                    return
                }
                file delete -force $fullTarget
            }

            file copy -force $item $targetDir
        }
    }
    
    return
}

# -----------------------------------------------------------------------------
# regsubOnFile --
#
#       This procedure applies a specified "regsub" operation throughout
#       a specified file.
#
# Arguments:
#       filename - name of the file to be modified.
#       from     - pattern for which all instances are to be changed.
#       to       - result of the pattern.
#
# Results:
#       No return value.

proc regsubOnFile {filename from to} {
    #  read the file into the local variable "contents".
    set fp [open $filename r]
    set contents [read $fp]
    close $fp
    
    #  Perform the ammendment.
    regsub -all $from $contents $to contents
    
    #  Make the file writeable.
    exec chmod u+w $filename

    #  write the contents back to the same file.
    set fp [open $filename w]
    puts -nonewline $fp $contents
    close $fp
    
    #  Return the file to an un-writeable state.
    exec chmod u-w $filename

    return
}

# ----------------------------------------------------------------------
# MAIN WINDOW
# ----------------------------------------------------------------------
wm title . "INSTALL"

if {![string equal $tcl_platform(platform) unix]} {
    puts "Unfortunately, installations on platforms other than unix, such as $tcl_platform(platform), are not supported at present"
    exit
}

frame .heading -background white -borderwidth 2 -relief sunken
pack .heading -fill x -padx 8 -pady 8

set imh [image create photo \
    -file [file join $::env(TSIPPwb) images workBench.gif]]
label .heading.icon -background white -image $imh

label .heading.title -background white \
    -text "TSIPP Work Bench"
catch {.heading.title configure -font -*-helvetica-bold-o-normal--*-180-*}

label .heading.version -background white \
    -text "version $progVersion"

label .heading.authors -background white \
    -text "by\nPaul Welton"

label .heading.copyright -background white \
    -text "\251 2001 Paul Welton"
catch {.heading.copyright configure -font -*-lucida-medium-r-normal-*-*-100-*}
catch {.heading.copyright configure -font 5x7}

grid .heading.icon      -row 0 -column 0 -rowspan 3
grid .heading.title     -row 0 -column 1
grid .heading.version   -row 1 -column 1
grid .heading.authors   -row 2 -column 1
grid rowconfigure .heading 2 -minsize 0.1i
grid .heading.copyright -row 3 -column 0 -columnspan 2

frame .install
pack .install -fill x -padx 4

label .install.title -text "Install:"
grid  .install.title  -row 0 -column 0 -sticky w

checkbutton .install.prog_c
grid  .install.prog_c -row 1 -column 0

label .install.prog_l -text "TSIPP Work Bench (version $progVersion)"
grid  .install.prog_l -row 1 -column 1 -sticky w

entry .install.prog_e
      .install.prog_e insert 0 "/usr/local"
grid  .install.prog_e -row 1 -column 2 -sticky w

label .install.ref_l  -text "with references to binaries in:"
grid  .install.ref_l  -row 2 -column 1 -sticky w

entry .install.ref_e
      .install.ref_e  insert 0 "/usr/local"
grid  .install.ref_e  -row 2 -column 2 -sticky w

frame .install.sep    -height 2 -borderwidth 1 -relief sunken
grid  .install.sep    -row 3 -column 0 -columnspan 3 -pady 8 -sticky ew
grid rowconfigure .install.sep 3 -weight 1

checkbutton .install.bin_c
grid  .install.bin_c  -row 4 -column 0

label .install.bin_l  -text "Install binaries to:"
grid  .install.bin_l  -row 4 -column 1 -sticky w

entry .install.bin_e
      .install.bin_e  insert 0 "/usr/local"
grid  .install.bin_e  -row 4 -column 2 -sticky w

message .install.bin_m  -text "(Only check this option if you wish to\
overwrite the existing tool libraries)" -aspect 600 -fg red
grid  .install.bin_m  -row 5 -column 0 -columnspan 3

frame .sep -height 2 -borderwidth 1 -relief sunken
pack  .sep -fill x -pady 8

frame .control
pack .control -fill x -padx 4 -pady 8
button .control.install -text "INSTALL" -command {
    set cmd {
        if {$prog_c} {
            install_prog     [.install.prog_e get] [.install.ref_e get]
        }
        if {$bin_c} {
            install_binaries [.install.bin_e get]
        }
    }
    
    if {[catch $cmd result] != 0} {
        notice_show "Error during installation:\n$result"
    } else {
        set top [notice_show "Installation complete."]
        set cntls [dialog_controls $top]
        $cntls.dismiss configure -command exit
    }
}

pack .control.install -side left -expand yes
button .control.exit -text "Exit" -command exit
pack .control.exit -side left -expand yes

focus .control.install
update
wm deiconify .
