#!/bin/sh
# The installation file for the X-Files
# The next line is executed by /bin/sh, but not Tcl \
exec wish $0 ${1+"$@"}
package require Tk 8.0

proc MAIN {} {
    global choice setting warning tcl_platform env

    set warning ""
    if {[string compare unix $tcl_platform(platform)] == 0} {
	catch {
	    if {[string match "root" [exec whoami]] == 0} {
		set warning "\n\nNOTE: You are not running this as root. You may encounter errors if you select system directories or try to make new directories in them..."
	    }
	}

	set setting(1) [file join / usr X11 bin]/
	set setting(2) [file join / usr X11 lib X11 x-files]/
	set setting(3) [file join / usr X11 include X11 pixmaps]/
	set setting(4) [file join / usr X11 man man1]/
    } {
	if {[string match *NT* $tcl_platform(os)]} {
	    # windows NT
	    set setting(1) [file join $env(SYSTEMDRIVE) {Program Files} X-Files]/
	    set setting(2) [file join $env(SYSTEMDRIVE) {Program Files} X-Files lib]/
	    set setting(3) [file join $env(SYSTEMDRIVE) {Program Files} X-Files lib]/
	    set setting(4) [file join $env(SYSTEMDRIVE) {Program Files} X-Files lib]/
	} elseif {[string match *95* $tcl_platform(os)]} {
	    # windows 95
	    set windir $env(WINDIR)
	    set dir [file dirname $windir]
	    set setting(1) [file join $dir {Program Files} X-Files]/
	    set setting(2) [file join $dir {Program Files} X-Files lib]/
	    set setting(3) [file join $dir {Program Files} X-Files lib]/
	    set setting(4) [file join $dir {Program Files} X-Files lib]/
	} {
	    puts stderr "Sorry, your system is not supported!"
	    exit 0
	}
	set setting(icon) 0
	set setting(man) 0
    }	

    wm withdraw .
    wm geometry . 400x300
    wm title . "X-Files Installation for v2.00b1"

    Frame

    bind . <Return> {
	.buttons.ok invoke
    }
    bind . <Escape> {
	.buttons.abort invoke
    }
    bind .entry.e <Tab> {
	DirComplete
	break
    }

    wm deiconify .

    set choice 0
    #console show
    while {$choice >= 0} {
	#puts $choice
	tkwait variable choice
	#puts "got choice $choice"
	if {$choice == 3 && [string compare windows $tcl_platform(platform)] == 0} {
	    ProcessChoice 5
	} {
	    ProcessChoice $choice
	}
    }
    exit 0

}


proc Frame {} {
    global choice e_text warning

    frame .buttons -relief groove -bd 2
    frame .text -relief ridge -bd 3

    button .buttons.ok -text "Install" -command {incr choice} -width 7
    button .buttons.abort -text "Abort" -command {
	set rc [tk_messageBox -parent . -icon question -message "Really abort installation?" -title "Confirm exit" -type yesno -default yes]
	if {[string compare $rc yes] == 0} {
	    exit 0
	}
    } -width 7
    button .buttons.no -width 7 -text "UnInstall" -command {UnInstall}
    pack .buttons.ok .buttons.no -side left
    pack .buttons.abort -side right

    message .text.t -justify center -width 394 \
	    -text "Welcome to X-Files installation!\n\n$warning" -font {fixed 12}

    pack .text.t -side top -fill both -expand 1
    pack .buttons -side bottom -fill x
    pack .text -side top -fill both -expand 1

    frame .entry -relief groove -bd 3
    label .entry.l -text "Path:"
    entry .entry.e -textvariable e_text -highlightthickness 1
    pack .entry.l -side left
    pack .entry.e -side left -fill x -expand 1

    update idletasks

}


proc ProcessChoice {choice} {
    global e_text setting tcl_platform

    set t .text.t
    . config -cursor watch
    update idletasks
    switch -- $choice {
	1 {
	    pack .entry -side bottom -fill x
	    focus .entry.e

	    catch {pack forget .buttons.no}
	    .buttons.ok config -text "Next" -width 5 -command {incr choice}
	    .buttons.abort config -width 5 -cursor pirate
	    .text.t config -justify left

	    $t config -text "Where do you want to put the main executable?\n\nRemember that at every step you can change our proposal by editing the text in the entry field.\n\nIf you input a non-existing directory, it will be made for you."
	    set e_text $setting(1)
	    .entry.e select range 0 end
	    .entry.e icursor end
	}
	2 {
	    set setting(1) [TildeSubst $e_text]
	    $t config -text "Where do you want to put the system-default configuration files and X-Files' tcl-library files?"
	    set e_text $setting(2)
	    .entry.e select range 0 end
	    .entry.e icursor end

	}
	3 {
	    set setting(2) [TildeSubst $e_text]
	    $t config -text "Do you want to use the X-Files icon?\n\nIf you do, remember to edit your window manager configuration file accordingly.\n\nIf you do not wish to install the icon, click \"Skip\"."
	    
	    .buttons.ok config -text "Yes" -command {set setting(icon) 1 ; incr choice}
	    .buttons.no config -text "Skip" -command {set setting(icon) 0 ; incr choice} -width 5
	    pack .buttons.no -side left
	    set e_text $setting(3)
	    .entry.e select range 0 end
	    .entry.e icursor end
	}
	4 {
	    set setting(3) [TildeSubst $e_text]
	    $t config -text "Do you want to install the X-Files man page?\n\nIf you do not wish to install the man page, click \"Skip\"."
	    
	    .buttons.ok config -text "Yes" -command {set setting(man) 1 ; incr choice}
	    .buttons.no config -text "Skip" -command {set setting(man) 0 ; incr choice} -width 5
	    pack .buttons.no -side left
	    set e_text $setting(4)
	    .entry.e select range 0 end
	    .entry.e icursor end
	}
	5 {
	    if {[string compare windows $tcl_platform(platform)] == 0} {
		set setting(2) [TildeSubst $e_text]
	    } {
		set setting(4) [TildeSubst $e_text]
	    }
	    if {$setting(icon)} {
		set tmp "X-Files icon in:"
		set tmp1 $setting(3)
	    }  {
		set tmp "Icon will not be installed."
		set tmp1 ""
	    }
	    if {$setting(man)} {
		set tmp2 "Man page in:"
		set tmp3 $setting(4)\n
	    }  {
		set tmp2 "Man page will not be installed."
		set tmp3 "\n"
	    }
	    $t config -text "You have chosen:\n\
		    [format "%-25s%-s\n%-25s%-s\n%-25s%-s\n%-25s%-s" "\nExecutable in:" " $setting(1)" \
		    "System-defaults in:" $setting(2) $tmp $tmp1 $tmp2 $tmp3] \
		    \nAre these correct? Select:\n\"Yes\",to start the actual installation\n\"No\", to input the directories again"

	    pack forget .entry

	    .buttons.ok config -text "Yes" -command {Install}
	    .buttons.no config -text "No" -command {set choice 1}
	}

    }
    . config -cursor top_left_arrow
    update idletasks

}

proc Install {} {
    global setting env tcl_platform

    . config -cursor watch
    set pwd [pwd]
    pack forget .entry
    pack forget .buttons.no
    .buttons.ok config -state disabled
    update idletasks

    if {[catch {file mkdir $setting(1) $setting(2)} err]} {
	Error "Unable to create directories!\n\n$err"
    }

    if {$setting(icon)} {
	if {[catch {file mkdir $setting(3)} err]} {
	    Error "Unable to create directory $setting(3)\n\n$err"
	}
    }
    if {$setting(man)} {
	if {[catch {file mkdir $setting(4)} err]} {
	    Error "Unable to create directory $setting(4)\n\n$err"
	}
    }

    .text.t config -justify center -text "Installing main executable in $setting(1)\n..."
    update idletasks
    set out [open X-Files.out w 0755]
    set source [open X-Files.tcl r]
    if {[string compare unix $tcl_platform(platform)] == 0} {
	# if unix
	set target X-Files
	puts $out "#!/bin/sh"
	puts $out "# The main file for the X-Files"
	puts $out "# The next line is executed by /bin/sh, but not Tcl \\"
	puts $out "exec wish \$0 \$\{1+\"\$\@\"\}"
    } {
	# windows
	set target X-Files.tcl
    }
    puts $out "set xf(xf_home) \[file join [file split $setting(2)]\]"
    puts $out [read $source]

    close $source
    close $out
    #eval exec chmod 755 X-Files
    after 2000
    if {[catch {file copy -force -- [file join $pwd X-Files.out] [file join $setting(1) $target]} err]} {
	Error "Unable to move \"X-Files\" to $setting(1)\n\n$err"
	exit
    }

    .text.t config -justify center -text "Installing configuration and library files in $setting(2)\n..."
    update idletasks
    after 2000
    cd $pwd
    lappend configs xfilesrc xfiles.ftpbook xfiles.buttons xfiles.extensions xfiles.headers xfiles.tags xfiles.user_pophelp
    foreach f $configs {
	if {[file exists $setting(2)$f]} {
	    if {[Query "Config file ($f) already exists in\n$setting(2)\n\nOverwrite?"]} {
		catch {file rename -force -- [file join $setting(2) $f] [file join $setting(2) $f.old]}
		if {[catch {file copy -force -- [file join $pwd $f] $setting(2)} err]} {
		    Error "Unable to copy config file $f to $setting(2)\n\n$err"
		    exit
		}
	    } {
		continue
	    }
	} {
	    file copy -force -- [file join $pwd $f] $setting(2)
	}
    }
    ###################################
    if {[catch {file copy -force -- xfiles.main_pophelp xfiles.manual xfiles.faq xflogo.gif be.tcl re.tcl ee.tcl fae.tcl vfs.tcl xf_sel.tcl ftpl.tcl bgexec.tcl $setting(2)} err]} {
	Error "Unable to copy library files to $setting(2)\n\n$err"
	exit
    }
    #cd $setting(2)
    #if [catch {eval exec chmod 644 [concat $files $configs]}] {
	#Error "Unable to change library files to mode 644.\nCheck permissions."
    #}
    #cd $pwd
    if {[catch {pkg_mkIndex $setting(2) *.tcl} err]} {
	Error "Fatal error!!\nUnable to create 'tclIndex' -file in directory $setting(2)\n$err"
	exit
    }
    #if [catch {eval exec chmod 644 $setting(2)tclIndex}] {
	#Error "Unable to change 'tclIndex' to mode 644.\nCheck permissions."
    #}

    if {$setting(icon)} {
	.text.t config -justify center -text "Installing icon in $setting(3)\n..."
	update idletasks
	after 2000
	if {[catch {file copy -force -- [file join $pwd X-Files.xpm] $setting(3)} err]} {
	    Error "Unable to copy X-Files.xpm to $setting(3)\n\n$err"
	}
	#cd $setting(3)
	#if [catch {eval exec chmod 644 X-Files.xpm}] {
	 #   Error "Unable to change icon permissions to 644."
	#}
	#cd $pwd
    }
    if {$setting(man)} {
	.text.t config -justify center -text "Installing man page in $setting(4)\n..."
	update idletasks
	after 2000

	set man [open X-Files.1x r]
	set man_new [open X-Files.1x.new w 0644]

	while {[gets $man line] >= 0} {
	    if {[string match {*configuration files are located in*} $line]} {
		puts $man_new $line
		puts $man_new ".IR $setting(2)"
	    } elseif {[string match {*can be found in*} $line]} {
		puts $man_new $line
		puts $man_new ".IR $setting(2)xfiles.manual"
	    }  {
		puts $man_new $line
	    }
	}
	close $man
	close $man_new

	if {[catch {file rename -force -- [file join $pwd X-Files.1x.new] [file join $setting(4) X-Files.1x]} err]} {
	    Error "Unable to copy X-Files.1x to $setting(4).\n\n$err"
	}
	#cd $setting(4)
	#if [catch {eval exec chmod 644 X-Files.1x}] {
	 #   Error "Unable to change man page permissions to 644."
	#}
	#cd $pwd
    }

    set try1 [string trimright $setting(1) /]
    regsub X11 $setting(1) X11R6 try2
    set try2 [string trimright $try2 /]

    if {[string match *$try1* $env(PATH)] || [string match *$try2* $env(PATH)]} {
	set path ""
    }  {
	set path $setting(1)
    }

    . config -cursor top_left_arrow
    .text.t config -justify center -text "Thank you for installing X-Files.\n\nYou can now start the program by typing \"[file join $path $target]\".\n\nWe hope you find it useful."
    pack forget .buttons.no .buttons.abort .buttons.ok
    .buttons.ok config -text "End of install" -command exit -state normal -width 17
    .buttons.no config -text "Start X-Files NOW!" -command [list Launch $target] -state normal -width 17
    pack .buttons.no -side left
    pack .buttons.ok -side right
    focus .buttons.no
    update idletasks

}

proc Launch {target} {
    global setting tcl_platform env

    if {[string compare windows $tcl_platform(platform)] == 0} {
	eval "exec $env(COMSPEC) /c start [list [file join $setting(1) $target]]"
    } {
	eval "exec [list [file join $setting(1) $target]] &"
    }
    exit 0
}

proc UnInstall {} {
    global e_text setting tcl_platform

    if {[string compare windows $tcl_platform(platform)] == 0} {
	Error "Sorry, this is not yet implemented for Windows!"
	exit
    }
    pack forget .buttons.no .entry.l
    pack .entry -side bottom -fill x
    set e_text "X-Files"
    .entry.e select range 0 end
    .entry.e icursor end
    .text.t config -justify center -text "Give either the name or the full path of the executable.\n\nThen click \"Start\" to begin uninstalling.\nNote that searching for the files may take a while..."
    .buttons.ok config -text "Start" -command {set s 1} -width 7
    focus .entry.e
    update idletasks
    tkwait variable s
    .buttons.ok config -state disabled
    pack forget .entry
    . config -cursor watch
    update idletasks

    set e_text [string trimright [TildeSubst $e_text] /]
    if {[string match */* $e_text]} {
	set files $e_text
	if {![file exists $files]} {
	    Error "File does not exist:\n\n$files"
	    exit
	}
    }  {
	.text.t config -text "Searching for $e_text\n\nThis may take a while..."
	update idletasks
	set files [Find $e_text]
    }

    if {[string compare {} $files] == 0} {
	Error "Could not find file $e_text\n\nPlease check name and start again!"
	exit
    }

    if {[llength $files] == 1} {
	ProcessFile $files
    }  {
	if {[Query "Found multiple files matching $e_text\nAre you sure about this?"]} {
	    foreach res $files {
		if {![file isdirectory $res]} {
		    ProcessFile $res
		}
	    }
	}
    }

    if {[Query "Do you want me to search the icon? (X-Files.xpm)\n\nNOTE! In big systems it can take a LONG time..."]} {
	.text.t config -text "Searching the icon.\n\nThis may take a while..."
	.buttons.ok config -state disabled
	.buttons.no config -state disabled
	update idletasks
	after 2000
	set pics [Find "X-Files.xpm"]

	.text.t config -text "Removing the icon..."
	.buttons.ok config -state normal
	.buttons.no config -state normal
	update idletasks
	foreach p $pics {
	    if {[Query "Do you want to remove\n\n$p\n?"]} {
		if {[catch {file delete -force -- $p} err]} {
		    Error "Unable to remove file $p\n\n$err"
		}
	    }
	}
    }

    if {[Query "Do you want me to search the man page? (X-Files.1x)\n\nNOTE! in big systems it can take a LONG time..."]} {
	.text.t config -text "Searching the man page.\n\nThis may take a while..."
	.buttons.ok config -state disabled
	.buttons.no config -state disabled
	update idletasks
	after 2000
	set mans [Find "X-Files.1x"]

	.text.t config -text "Removing the man page..."
	.buttons.ok config -state normal
	.buttons.no config -state normal
	update idletasks
	foreach m $mans {
	    if {[Query "Do you want to remove\n\n$m\n?"]} {
		if {[catch {file delete -force -- $m} err]} {
		    Error "Unable to remove file $m\n\n$err"
		}
	    }
	}
	after 2000
    }

    . config -cursor top_left_arrow
    .text.t config -justify center -text "Finished!!!\n\nX-Files uninstalled.\n\nIf you encountered errors, please check paths and permissions and try again."
    pack forget .buttons.no .buttons.abort .buttons.ok
    .buttons.ok config -text "OK!" -command exit -state normal
    pack .buttons.ok -side bottom
    focus .buttons.ok
    update idletasks
}

proc ProcessFile {file} {
    global s

    set id [open $file r]
    while {[gets $id try] >= 0} {
	if {[string match {set xf(xf_home)*} $try]} {
	    break
	}
    }
    close $id
    if {![string match {set xf(xf_home)*} $try]} {
	Error "Could not find library path definition.\nAre you sure $file is an X-Files file?"
	set lib_path "N/A"
    }  {
	regexp {.*\"(.*)\".*} $try grg path
	set lib_path [string trimright $path /]
    }

    .text.t config -justify center -text "Do you want to remove\n$file\n\nand it's library directory\n$lib_path\n?"

    .buttons.ok config -text "Yes" -command {set s 1} -state normal
    .buttons.no config -text "No" -command {set s 0} -state normal
    pack .buttons.no -side left
    . config -cursor top_left_arrow
    update idletasks
    tkwait variable s

    if {$s == 0} {return}

    .text.t config -justify center -text "Removing executable:\n\n$file"
    .buttons.ok config -state disabled
    .buttons.no config -state disabled
    . config -cursor watch
    update idletasks

    after 2000
    if {[catch {file delete -force -- $file} err]} {
	Error "Could not remove file $file\n\n$err"
    }

    .text.t config -text "Removing the library directory:\n\n$lib_path"
    update idletasks
    after 2000
    if {[catch {file delete -force -- $lib_path} err]} {
	Error "Could not remove directory $lib_path\n\n$err"
    }

}

proc Query {string} {
    global s
    . config -cursor top_left_arrow
    .text.t config -justify center -text $string

    .buttons.ok config -text "Yes" -command {set s 1} -state normal
    .buttons.no config -text "No" -command {set s 0} -state normal
    pack .buttons.no -side left
    . config -cursor top_left_arrow
    update idletasks
    tkwait variable s
    return $s
}

proc Error {string} {
    . config -cursor top_left_arrow
    pack forget .buttons.no
    .text.t config -justify center -text "ERROR!!!\n\n$string"
    .buttons.ok config -state normal -text "Go on" -command {set s 1}
    update idletasks
    tkwait variable s
    .buttons.ok config -state disabled
    . config -cursor watch
    update idletasks
}

proc Find {file} {
    global result

    catch {set res [exec find / -name $file -print]} res

    set res [split $res \n]
    set index [lsearch $res *$file]
    set result {}
    while {$index != -1} {
	lappend result [lindex $res $index]
	set res [lreplace $res 0 $index]
	set index [lsearch $res *$file]
    }
    return $result
}

proc TildeSubst {path {s {}}} {
    global env tcl_platform

    if {[string compare windows $tcl_platform(platform)] == 0} {
	# Windows TODO
	return [string trimright [file join $path] /]/
    }

    if {[catch {set dir [pwd]/}]} {
	set dir [string trimright $env(HOME) /]/
    }
    set path [string trimright $path /]/
    set rc $path
    if {[string match "\." $path] || [string match "\./" $path]} {
	set rc [string trimright $dir /]/
    } elseif {[regexp {^~[^/]*/} $path beg]} {
	if {[catch {glob -- $beg} err]} {
	    #MessageBox "Invalid pathname: $path\nError: $err" $s
	    set rc [string trimright $env(HOME) /]/
	} {
	    regsub {^~[^/]*/} $path $err/ rc
	}
    } elseif {[regexp {\.\./} $path beg]} {
	if {[catch {cd $beg} err]} {
	    #MessageBox "Invalid pathname: $path\nError: $err" $s
	    set rc [string trimright $env(HOME) /]/
	} {
	    set new [pwd]
	    regsub {\.\./} $path $new/ rc
	}
    } elseif {![string match {/*} $path]} {
	regsub {^\./} $path {} path
	set rc [string trimright [pwd] /]/[string trimright $path /]/
    }
    catch {cd $dir}
    return $rc
}

proc DirComplete {} {
    global e_text

    if {[string compare {} $e_text] == 0} {
	set e_text /
	.entry.e icursor end
	bell
	return
    }
    if {[file isdirectory $e_text]} {
	if {[string match */ $e_text] || \
		[llength [GetDirsInDir $e_text]] > 1} {
	    bell
	} {
	    set e_text [string trimright $e_text /]/
	}
	.entry.e xview moveto 1
	.entry.e icursor end
	return
    }
    set tail [file tail $e_text]
    set dir {}
    if {[string match /* $e_text] && ![string match /*/* $e_text]} {
	set dir [lindex [file split $e_text] 0]
    } elseif [string match /*/* $e_text] {
	set dir [file dirname $e_text]/
    } elseif {[string match {/*} $e_text]} {
	set dir [lindex [file split $e_text] 0]
	set tail $e_text
    }
    if {[string compare {//} $dir] == 0} {
	set dir /
    }
    set dirs [GetDirsInDir $dir $tail]

    if {[llength [split $dirs]] == 1} {
	set e_text $dir$dirs
	.entry.e xview moveto 1
	.entry.e icursor end
    } {
	if {[llength [split $dirs]] > 1} {
	    set l [expr [string length $tail] -1]
	    set miss 0
	    set dir1 [lindex $dirs 0]
	    while {!$miss} {
		incr l
		if {$l == [string length $dir1]} {
		    break
		}
		set new [string range $dir1 0 $l]
		foreach d $dirs {
		    if {![string match $new* $d]} {
			set miss 1
			incr l -1
			break
		    }
		}
	    }
	    set e_text $dir[string range $dir1 0 $l]
	    .entry.e xview moveto 1
	    .entry.e icursor end
	}
	bell
    }
}
proc GetDirsInDir {dir {stub {}}} {
    set dirs {}

    set files [lsort [glob -nocomplain -- $dir$stub{.*,*}]]

    foreach f $files {
	if {[string match {*\.\.} $f] || [string match {*\.} $f]} {
	    continue
	}
	if {[file isdirectory $f]} {
	    lappend dirs [file tail $f]/
	}
    }

    return $dirs
}

MAIN

