#
# $Source: /home/nlfm/Working/Zircon/Released/installer/RCS/support.tcl,v $
# $Date: 2000/02/02 10:09:16 $
# $Revision: 1.18.1.41 $
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 2000 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
package provide support 1.18
#
proc askUser {title msg} {
    global go
    if {$go} { return 1 }
    return [tk_dialog .ask $title $msg question 1 No Yes]
}
#
proc fail {msg} {
    tk_dialog .err Error! $msg error 0 OK
}
#
proc zinfo {msg} {
    global NoGUI
    if {!$NoGUI} { .inst.info configure -text $msg }
    update
}
#
proc Quit {} {
    exit
}
#
proc Go {} {
    global NoGUI
    if {!$NoGUI} {
        catch {.inst configure -cursor {watch red}}
        foreach x [winfo children .inst] {
	    catch {$x configure -cursor {watch red}}
	    catch {$x configure -state disabled}
        }
        .inst.btn.install configure -state disabled
    }
    if {[makeLibrary] && [makeBinary]} {
	zinfo Done!!
	if {[catch {open install.in w} fd]} {
	} {
	    foreach x {Type Lib Bin CC SCflag SLDflag CFlags Wish TIDir} {
		puts $fd "set $x {[uplevel #0 set $x]}"
	    }
	    close $fd
	}
    }
    if {!$NoGUI} {
	foreach x [winfo children .inst] {
	    catch {$x configure -state normal}
	    catch {$x configure -cursor arrow}
	}
	.inst.btn.install configure -state normal
	catch {.inst configure -cursor arrow}
    }
}
#
proc ncopy {file to} {
    if {![file exists [file join $to $file]]} { copy $file $to }
}
#
proc gridIt {w name row} {
    grid $w.$name -row $row -column 0 -sticky w -pady 2
    grid $w.${name}entry -sticky ew -row $row -column 1 -pady 2
}
#
proc fixPath {dir} {
    switch [file pathtype $dir] absolute {return $dir}
    return [file join [pwd] $dir]
}
#
#
proc copy {from to} {
    zinfo "Copying $from ..."
    set to [dmake [file dirname $from] $to]
    set target [file join $to [file tail $from]]
    copyfile $from $target
    mkReadable $target
}
#
proc dmake {from to} {
    switch . $from {} default {
	foreach x [file split $from] {
	    set to [file join $to $x]
	    if {![file exists $to]} {
	        filemkdir $to
	        makeExecutable $to
	    }
	}
    }
    return $to
}
#
proc dirmake {dir} {
    set dir [fixPath $dir]
    set to {}
    foreach x [file split $dir] {
	set to [file join $to $x]
	if {![file exists $to]} {
	    filemkdir $to
	    makeExecutable $to
	}
    }
}
#
proc doGlobals {argv} {
    global Type types Lib Bin CC LD Version Patchlevel Wish types cflags\
      libs share SCflag GCC SLDflag CFlags TIDir Prefix ExecPrefix SED go \
      pseudo
#
    source [file join installer zircon.tcl]
    set Type {}
    set Lib {}
    set Bin {}
    set CC {}
    set LD ld
    set GCC 1
    set SCflag {}
    set SLDflag {}
    set CFlags {}
    set Wish {}
    set TIDir {}
    set go 0
    set SED 0
    set pseudo {}
#
    while {![string match {} $argv]} {
	set v [lindex $argv 1]
	switch -glob -- [lindex $argv 0] {
	-b {set Bin $v }
	-c {set CC $v}
	-d {set LD $v}
	-e {set SED 1}
	-f {set CFlags $v}
	-g {set go 1 ; set argv [lrange $argv 1 end] ; continue }
	-h {set TIDir $v}
	-l {set Lib $v }
	-p {set pseudo $v}
	-s {set SCflag $v}
	-t {set Type $v }
	-w {set Wish $v}
	-z {set SLDflag $v }
	}
	set argv [lrange $argv 2 end]
    }
    switch {} $pseudo {} default { dirmake $pseudo }
    catch {source install.in}
    return $argv
}
#
proc mainWindow {} {
    global Version Patchlevel NoGUI
    if {$NoGUI} { return {} }
    set w [toplevel .inst]
    wm title $w {Zircon Installer}
    wm resizable $w 1 0 
    grid columnconfigure $w 1 -weight 1
    frame $w.vinfo -relief groove -borderwidth 3
    set img [image create photo -file [file join gifs zlogo.gif]]
    label $w.vinfo.vlogo -image $img -relief groove -borderwidth 3
    label $w.vinfo.version -text Zircon
    label $w.vinfo.patch -text "Version $Version Patchlevel $Patchlevel"
    grid columnconfigure $w.vinfo 0 -weight 1
    grid $w.vinfo.version -sticky ew -row 0 -column 0
    grid $w.vinfo.patch -sticky ew -row 1 -column 0
    grid $w.vinfo.vlogo -sticky e -row 0 -column 1 -rowspan 2
    grid $w.vinfo - -sticky ew
    grid [frame $w.sep1 -bg red] - -sticky ew -pady 2
    return $w
}
#
proc makeEntry {w wn txt var row cmd} {
    global NoGUI
    if {!$NoGUI} {
        label $w.$wn -text $txt -relief raised
	entry $w.${wn}entry -textvariable $var
    }
    $cmd
    if {!$NoGUI} { gridIt $w $wn $row }
}
#
proc Null {} { }
#
proc pWrap {fn} {
#
# HACK ALERT!!!!!
#
    global pseudo
    switch {} $pseudo { return $fn }
    switch [file pathtype $fn] absolute {
        return [file join $pseudo [string range $fn 1 end]]
    }
    return [file join $pseudo $fn]
}
#
proc makeLibrary {} {
    global Lib Manifest Index Patchlevel Version TIDir go
    switch {} $TIDir {} default {
	if {![file exists [set TIDir [fixPath $TIDir]]]} {
	    fail "Directory \"$TIDir\" does not exist"
	    return 0
	}
	if {![file isdirectory $TIDir]} {
	    fail "\"$TIDir\" is not a directory"
	    return 0
	}
	if {![file exists [file join $TIDir tcl.h]]} {
	    fail "tcl.h does not exist in \"$TIDir\""
	    return 0
	}
    }
    set Lib [fixPath $Lib]
    if {[file exists [pWrap $Lib]]} {
	if {[file exists [pWrap [set fn [file join $Lib installed]]]]} {
	    set fd [open [pWrap $fn] r]
	    gets $fd line
	    close $fd
	    set ov [lindex $line 0]
	    set op [lindex $line 1]
	    set ext -$Version.$Patchlevel
	    switch $ov $Version {
		switch $op $Patchlevel {
		   if {![askUser {Same Version} "You are installing version\
$Version $Patchlevel again.

Do you want to continue?"]} { exit }
   		   if {$go || [tk_dialog .ask "Same Version" "Do you want to overwrite\
the existing version?" question 1 Rename Overwrite]} { set ext {} }
		}
	    }
	} {
	    set ext .old
	}
	switch {} $ext {} default {
	    if {[catch {filerename [pWrap $Lib] [pWrap $Lib$ext]} msg]} {
		if {![askUser Continue "Cannot rename $Lib to \
		  $Lib.old - \"$msg\"

Continue?"]} { return 0 }
	    }
	    if {[catch {dirmake [pWrap $Lib]} msg]} {
		fail "Cannot make directory $Lib - \"$msg\""
		return 0
	    }
	}
    } \
    elseif {[catch {dirmake [pWrap $Lib]} msg]} {
	fail "Cannot make directory [pWrap $Lib] - \"$msg\""
	return 0
    }
    foreach x [lsort [array names Manifest]] { 
	switch {} $Manifest($x) {} default {$Manifest($x) $x [pWrap $Lib] }
    }
    foreach x $Index {
	zinfo "Making package index for $x..."
	if {[catch {pkg_mkIndex [pWrap [file join $Lib $x]] *.tcl \
	  *[info sharedlibextension]} msg]} {
	    fail "Error whilst making package index for $x - \"$msg\""
	    return 0
	}
    }
    set fd [open [pWrap [file join $Lib installed]] a]
    puts $fd "$Version $Patchlevel {[clock format [clock seconds]]}"
    close $fd
    return 1
}
#
proc makeBinary {} {
    zinfo "Making zircon..."
    global Bin Lib Version Patchlevel Wish Xtn
    if {![file exists [pWrap [set Bin [fixPath $Bin]]]]} {
	if {[catch {dirmake [pWrap $Bin]} msg]} {
	    fail "Cannot create directory \"$Bin\" - $msg"
	    return 0
	}
    } \
    elseif {![file isdirectory [pWrap $Bin]]} {
	fail "\"$Bin\" is not a directory"
	return 0
    }
    set tf [pWrap [file join $Bin zircon]]
    if {[file exists $tf$Xtn]} {
	if {[catch {filerename $tf$Xtn $tf.old} msg]} {
	   fail "Cannot rename previous zircon executable - \"$msg\""
	   return 0
	}
    }
    if {[catch {open $tf$Xtn w 0755} fd]} {
	fail "Cannot create zircon executable - \"$fd\""
	if {[file exists $tf.old]} {
	    file rename -force $tf.old $tf$Xtn
	}
	return 0
    }
    puts $fd "#!$Wish
set zircon(lib) [whereLib]
#
proc zVersion {} {
    global zircon
    array set zircon {
	version		$Version
	patchlevel	$Patchlevel
    }
}
#
[info body zircon]"
    close $fd
    makeExecutable $tf$Xtn
    return 1
}
#
proc show {w file} {
    if {[winfo exists $w]} {
        raise $w
	wm deiconify $w
	return
    }
    toplevel $w
    wm title $w "Zircon $file"
    grid columnconfigure $w 0 -weight 1
    grid rowconfigure $w 0 -weight 1
    scrollbar $w.vs -command "$w.txt yview"
    scrollbar $w.hs -orient horizontal -command "$w.txt xview"
    text $w.txt -width 80 -height 24 -yscrollcommand "$w.vs set" \
      -xscrollcommand "$w.hs set" -wrap none
    button $w.ok -command "destroy $w" -text OK
    set fd [open $file r]
    while {![eof $fd]} {
        $w.txt insert end [gets $fd] {} "\n"
    }
    grid $w.txt -row 0 -column 0 -sticky nsew
    grid $w.vs -row 0 -column 1 -sticky ns
    grid $w.hs -row 1 -column 0 -sticky ew
    grid $w.ok -columnspan 2
}
#
proc putButtons {w} {
    global NoGUI
    if {!$NoGUI} {
	grid [frame $w.sep3 -bg red] - -sticky ew -pady 2
	frame $w.btn
	button $w.btn.quit -text Quit -command Quit -width 12
	button $w.btn.install -text Install -command Go -width 12
	grid $w.btn.quit $w.btn.install
	grid columnconfigure $w.btn 0 -weight 1
	grid columnconfigure $w.btn 1 -weight 1
	set col 1
	if {[file exists CHANGES]} {
            button $w.btn.changes -text Changes -command "show .ch CHANGES" -width 10
	    grid $w.btn.changes -row 0 -column [incr col]
	    grid columnconfigure $w.btn $col -weight 1
	}
        if {[file exists [file join doc FAQ]]} {
            button $w.btn.faq -text FAQ -command "show .fq [file join doc FAQ]" -width 10
	    grid $w.btn.faq -row 0 -column [incr col]
 	    grid columnconfigure $w.btn $col -weight 1
       }
        if {[file exists [file join doc COPYRIGHT]]} {
            button $w.btn.crt -text Copying \
	      -command "show .cp [file join doc COPYRIGHT]" -width 10
	    grid $w.btn.crt -row 0 -column [incr col]
	    grid columnconfigure $w.btn $col -weight 1
        }
        grid $w.btn -columnspan 2 -sticky ew
    }
}

