#! /usr/X11R6/bin/wish 
# $Header: /home/uebb/uebb/CVS/ocs/opalwizard,v 1.5 2001/05/23 18:56:22 kd Exp $



# some global variables

set fontbold -*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*
set font1 -*-helvetica-bold-r-*-*-24-*-*-*-*-*-*-*
set font2 -*-helvetica-bold-r-*-*-16-*-*-*-*-*-*-*
set fonttt -*-lucidatypewriter-medium-*-normal-*-12-*-*-*-*-*-*-*
set fontsmall -*-helvetica-medium-r-*-*-10-*-*-*-*-*-*-*

set prefix /usr/local
set optionList {dynamic absolute-pathes doc oasys dosfop opalwin \
		    reflections tivi2 opaljava oc5 proofchecker locallinks}
array set option { }
set useCache 0
set makeTargets {}

# currentWorkFrame

## set up main window

. configure -background navyblue
wm iconname . opalwizard
wm iconbitmap . {@opal.xbm}

## MENU

frame .mbar -relief raised -bd 2 
menubutton .mbar.file -text File -menu .mbar.file.menu
menubutton .mbar.action -text Action -menu .mbar.action.menu
menubutton .mbar.expert -text Expert -menu .mbar.expert.menu

pack .mbar.file .mbar.action .mbar.expert -side left -anchor nw
pack .mbar -expand 1 -fill both

menu .mbar.file.menu
.mbar.file.menu add command -label About -command midAbout
.mbar.file.menu add command -label Quit -command midQuit -accelerator "Ctrl+Q"
menu .mbar.action.menu
.mbar.action.menu add command -label "Configure OCS" -command midConfigure
.mbar.action.menu add command -label "Install OCS" -command midInstall
menu .mbar.expert.menu
.mbar.expert.menu add command -label "Select OCS Version" -command midSelectVersion
.mbar.expert.menu add command -label "Install Some packages" -command midPackages
.mbar.expert.menu add command -label "Show Output of Last Command" -command midShowLastOutput


bind . <Control-q> { midQuit }


## TOP LINE: image + headline


frame .top  -background lightblue

image create photo opalimage -file opal.gif
canvas .top.image -width 58 -height 57
.top.image create image 31 30 -image opalimage

label .top.headline -text "The Opal Wizard"  -background lightblue -font $font1


pack .top.image .top.headline -side left -expand 1 -fill y

## PLACEHOLDER: ABOUT

set currentWorkFrame ""

## DISPLAY MAIN WINDOW
pack .top 




## ======================================================================
## BUTTON COMMANDS

### About
proc midAbout { } {
    global currentWorkFrame font2 fonttt

    if { $currentWorkFrame == ".about" } { return }

    frame .about -height 5c -background white -relief ridge -borderwidth 4
    message .about.who -text "Copyright 2000\nby the Opal Group" -font $font2 -aspect 1000 -background white
    set revision {$Date: 2001/05/23 18:56:22 $#$Revision: 1.5 $}
    regsub -all "\\$" $revision "" revision2
    regsub -all "#" $revision2 "\n" revision
    message .about.revision -text $revision -background white -aspect 1000
    label .about.email -text "opal@cs.tu-berlin.de" -background white -font $fonttt
    label .about.http -text "http://uebb.cs.tu-berlin.de/~opal" -background white -font $fonttt
    pack .about.revision .about.who .about.email .about.http
    replaceWorkFrame .about
}


### Configure
proc midConfigure { } {
    global prefix font2 option optionList useCache currentWorkFrame

    if { $currentWorkFrame == ".configure" } { return }

    midConfigureCancel
    # parray option

    frame .configure 
    replaceWorkFrame .configure

    label .configure.headline -text "Configure OCS" -font $font2  -bg white
    namedEntry .configure.prefix "OCS Root Directory:" prefix

    frame .configure.options
    checkbutton .configure.options.cache -text "use cache file" -variable useCache -anchor w
    pack .configure.options.cache -expand 1 -fill x
    foreach o $optionList {
	checkbutton .configure.options.$o -text $o -variable option($o) -anchor w
	pack .configure.options.$o -expand 1 -fill x 
    }
    
    frame .configure.buttons
    button .configure.buttons.do -text "Configure" -command midConfigureDo
    button .configure.buttons.default -text "Default" -command midConfigureDefault
    button .configure.buttons.cancel -text "Cancel" -command midConfigureCancel
    pack .configure.buttons.do .configure.buttons.default .configure.buttons.cancel -side left -expand 1 -fill x
    
    pack .configure.headline -expand 1 -fill x
    pack .configure.prefix .configure.options .configure.buttons -expand 1 -fill x

}

proc midConfigureDo { } {
    global prefix option optionList useCache midConfigureProgress fonttt

    midConfigureSave
    .mbar.action.menu entryconfigure 2 -state disabled
    foreach b {do default cancel} {
	.configure.buttons.$b configure -state disabled
    }
    frame .configure.progress -relief ridge -borderwidth 4
#    label .configure.progress.l -text "Configuring ...." 
#    message .configure.progress.l2 -text " <output> " -font $fonttt -width 200p -justify left -anchor w
#    pack .configure.progress.l .configure.progress.l2 -expand 1 -fill x 
#    pack .configure.progress -expand 1 -fill x 
#    update

    set cmd "./configure"
    set cmd "$cmd --prefix=$prefix"
    if { ! $useCache } { 
	set cmd "$cmd --cache-file=/dev/null" 
    }

    foreach o $optionList {
	if {$option($o)} {
	    set cmd "$cmd --enable-$o"
	} else {
	    set cmd "$cmd --disable-$o"
	}
    }

#    set configError [backExecW $cmd .configure.progress.l2 200]
    set configError [backExecO $cmd .configure.progress 200 "Configuring ..." "Configure" midConfigureDoAux1 40]
			 
#    if $configError {
#	label .configure.progress.l3 -text "Configure failed!" -fg red
#	button .configure.progress.b -text "See output" -command midConfigureDoAux3
#    } else { 
#	label .configure.progress.l3 -text "Configure succeeded!"
#	button .configure.progress.b -text "OK" -command midConfigureDoAux1
#	.mbar.action.menu entryconfigure 2 -state normal
#    }
#    pack forget .configure.progress.l .configure.progress.l2
#    pack .configure.progress.l3 -expand 1 -fill x  -side left
#    pack .configure.progress.b -side left 
}

proc midConfigureDoAux1 { result } {
    foreach b {do default cancel} { 
	.configure.buttons.$b configure -state normal
    } 
    if { ! $result } {
	.mbar.action.menu entryconfigure 2 -state normal
    }
}


proc midConfigureCancel { } {
    global option prefix useCache

    # read previously stored values
    if [file exists opalconfig.last] {
	source opalconfig.last
    } else {
	midConfigureDefault
    }
}

proc midConfigureDefault { } {
    global prefix option 

    # default values
    set useCache 0

    set option(dynamic) 1
    set option(absolute-pathes) 1
    set option(doc) 0
    set option(oasys) 1
    set option(dosfop) 0
    set option(opalwin) 1
    set option(reflections) 1
    set option(tivi2) 1
    set option(opaljava) 0
    set option(oc5) 0
    set option(proofchecker) 0
    set option(locallinks) 1

    set prefix /usr/local
}

proc midConfigureQuit { } {

    midConfigureSave
#    destroy .configure
    .mid.configure configure -state normal
}

proc midConfigureSave { } {
    global prefix option optionList useCache

    if [catch {set fid [open "opalconfig.last" "w"]} ] {
	errorMsg "Could not open opalconfig.last. Configuration not saved."
	return
    }
    set now [exec "date"]
    puts $fid "\#\# OCS configuration saved by opalconfig at $now"
    puts $fid "set prefix $prefix"
    puts $fid "set useCache $useCache"
    foreach o $optionList {
	puts $fid "set option($o) $option($o)"
    }
    close $fid
}

### Install OCS
proc midInstall { } {
    global font2 makeTargets fontsmall elapsed elapsedCount currentWorkFrame

    if { $currentWorkFrame == ".tInstall"} { return }

    frame .tInstall -background white
    replaceWorkFrame .tInstall

    label .tInstall.headline -text "Install OCS" -font $font2 -background white
    pack .tInstall.headline
    source opalconfig.makeTargets
    set no 0
    set fidx 0
    frame .tInstall.f$fidx
    foreach t $makeTargets {
	regsub -all "\\." $t "_" l
	label .tInstall.$l -text $t -background grey -anchor w -font $fontsmall -width 30
	pack .tInstall.$l -expand 1 -fill x -in .tInstall.f$fidx -side left
	incr no
	if { $no == 3 } {
	    pack .tInstall.f$fidx
	    incr fidx
	    set no 0
	    frame .tInstall.f$fidx
	}
    }
    if { $no > 0 && $no < 3} {
	pack .tInstall.f$fidx -anchor w
    }
    frame .tInstall.b -width 5c
    frame .tInstall.msg
    set n [llength $makeTargets]
    label .tInstall.msg.l1 -text "$n packages" -background white
    pack .tInstall.msg.l1  -side left
    pack .tInstall.msg
    button .tInstall.b.start -text Install -command "midInstallDo [list $makeTargets ]"
    pack .tInstall.b.start  -side left -expand 1
    pack .tInstall.b -expand 1 -fill x

}

proc midInstallDo { thisMakeTargets } { 
    global fonttt tInstallProgress t runTimer

    frame .tInstall.progress -relief ridge -borderwidth 4
    .tInstall.b.start configure -state disabled
    button .tInstall.b.cancel -text Cancel -command midInstallCancel
    pack .tInstall.b.cancel

    backExecOPrep .tInstall.progress 70 "Now making <target> ..."

    set n [llength $thisMakeTargets]
    set i 0
    foreach t $thisMakeTargets {
	.tInstall.progress.l configure -text "Now making $t ..."
	regsub -all "\\." $t "_" l
	.tInstall.$l configure -background green
	update
	set res [ backExecW "make $t" .tInstall.progress.l2 1000 ]
	incr i
	if {$res == 0} {
	    .tInstall.$l configure -background white
	    .tInstall.msg.l1 configure -text "installed $i of $n OCS packages"
	} else {
	    .tInstall.$l configure -background red
	    break
	}
	update
    }
    catch {destroy .tInstall.b.cancel}

    backExecONotify $res .tInstall.progress midInstallDoAux "Installation completed successfully" "make $t failed with >$res<!"

    backExecOClose .tInstall.progress
    
}

proc midInstallQuit { } {

    .tInstall.b.start configure -state normal
}

proc midInstallDoAux { res } {
    .tInstall.b.start configure -state normal
    catch {destroy .tInstall.b.cancel}
}

proc midInstallCancel { } {
    global pid

    set x [catch {exec kill $pid} msg]
}

proc midInstallTimer { } {
    global runTimer elapsed elapsedCount

    if $runTimer {
	incr elapsedCount
	set min [expr $elapsedCount / 60]
	set sec [expr $elapsedCount % 60]
	set elapsed [format "%02d:%02d min" $min $sec]
	after 1000 midInstallTimer
    }
}
	

### Select Version
proc midSelectVersion { } {
    global prefix font2 currentOCSversion ocslist currentWorkFrame

    if {$currentWorkFrame == ".tSelectVersion"} { return }

	set currentOCSversion [ocsVersionInDir $prefix/ocs]

	set ocslist { }
	set ocslist1 [glob $prefix/ocs?*]
	foreach f $ocslist1 { 
	    if {[ocsVersionInDir $f] != ""} { lappend ocslist $f }
	}
	
        frame .tSelectVersion
        replaceWorkFrame .tSelectVersion
	label .tSelectVersion.headline -text "Select OCS Version" -font $font2 -background white
	namedLabel .tSelectVersion.current "Current:" currentOCSversion
	frame .tSelectVersion.lb
	listbox .tSelectVersion.lb.available -yscrollcommand ".tSelectVersion.lb.scroll set" -selectmode single 
	scrollbar .tSelectVersion.lb.scroll -command ".tSelectVersion.lb.available yview"
	pack .tSelectVersion.lb.available -expand 1 -fill both -side left
	pack .tSelectVersion.lb.scroll -side left -fill y 
	set i 0
        set j 0
	foreach f $ocslist {
	    set v [ocsVersionInDir $f]
	    if {$v != ""} {
  	      .tSelectVersion.lb.available insert end $v
	      if {$v == $currentOCSversion} {
		  .tSelectVersion.lb.available selection set $i
		  set j $i
	      }
	      incr i
	    }
	}
        .tSelectVersion.lb.available yview $j
	frame .tSelectVersion.b
	button .tSelectVersion.b.apply -text "Apply" -command midSelectVersionApply
	pack .tSelectVersion.b.apply -side left -expand 1 -fill x
	pack .tSelectVersion.headline .tSelectVersion.current  .tSelectVersion.lb .tSelectVersion.b -expand 1 -fill x
}

proc midSelectVersionQuit { } {
    midSelectVersionApply
}

proc midSelectVersionApply { } {
    global ocslist currentOCSversion prefix

    set select [ .tSelectVersion.lb.available curselection ]
    if {$select != {} } {
	set newOCSversion [ocsVersionInDir [lindex $ocslist $select]]
	if {$newOCSversion != $currentOCSversion} {
	    set newdir [lindex $ocslist $select]
	    if {[file exists $prefix/ocs] && [file type $prefix/ocs] == "directory"} {
		errorMsg "Expected $prefix/ocs to be a link to the current version. Will not remove directory."
		return
	    } else {
		if [ catch { exec rm -f $prefix/ocs } msg ] {
		    errorMsg "No permission to remove $prefix/ocs: $msg"
		    return
		}
		if [catch {exec ln -s $newdir $prefix/ocs} msg] {
		    errorMsg "Could not relink $prefix/ocs to $newdir: $msg"
		    return
		}
		set currentOCSversion $newOCSversion
	    }
	}
    } else {
#	puts "nothing: select = $select"
    }
}

proc ocsVersionInDir fname {    
    
    if {[file exist "$fname"] && [file isdirectory $fname] && [file exist "$fname/VERSION"]} {
	set vId [open "$fname/VERSION" "r"]
	set thisOCSversion [read -nonewline $vId]
	close $vId			       
	return $thisOCSversion
    } else {
	return ""
    }
}

### SELECT PACKAGES
set midPackagesN 0
array set midPackagesT { }
proc midPackages { } {
    global midPackagesN currentWorkFrame fontsmall midPackagesT makeTargets
    
    if {$currentWorkFrame == ".tPackages" } { return }
    initForMenuEntry .tPackages "Install Some Packages"

    source opalconfig.makeTargets
    set no 0
    set fidx 0
    frame .tPackages.f$fidx
    foreach t $makeTargets {
	regsub -all "\\." $t "_" l
	set midPackagesT($l) 0
	checkbutton .tPackages.$l -text $t -background grey -anchor w -font $fontsmall -width 30 -variable midPackagesT($l) -command "midPackagesButton $l"
	pack .tPackages.$l -expand 1 -fill x -in .tPackages.f$fidx -side left
	incr no
	if { $no == 3 } {
	    pack .tPackages.f$fidx
	    incr fidx
	    set no 0
	    frame .tPackages.f$fidx
	}
    }
    if { $no > 0 && $no < 3} {
	pack .tPackages.f$fidx -anchor w
    }
    frame .tPackages.b -width 5c
    frame .tPackages.msg
    set midPackagesN 0
    label .tPackages.msg.l1 -text "selected $midPackagesN packages" -background white
    pack .tPackages.msg.l1  -side left
    pack .tPackages.msg
    button .tPackages.b.start -text Install -command "midPackagesDo "
    pack .tPackages.b.start  -side left -expand 1
    pack .tPackages.b -expand 1 -fill x

}
 
proc midPackagesButton { thisButton } {
    global midPackagesN midPackagesT

    if { $midPackagesT($thisButton) } then {
	incr midPackagesN 
	.tPackages.$thisButton configure -background white
    } else {
	incr midPackagesN  -1
	.tPackages.$thisButton configure -background grey
    }
    .tPackages.msg.l1 configure -text "selected $midPackagesN packages"    
}

proc midPackagesDo { } {
    global midPackagesT midPackagesN makeTargets

    frame .tPackages.progress -relief ridge -borderwidth 4
    .tPackages.b.start configure -state disabled
    button .tPackages.b.cancel -text Cancel -command midPackagesCancel
    pack .tPackages.b.cancel

    backExecOPrep .tPackages.progress 70 "Now making <target> ..."

    set i 0
    set res 0
    foreach t $makeTargets {
	regsub -all "\\." $t "_" l
	if { $midPackagesT($l) } {
	    .tPackages.progress.l configure -text "Now making $t ..."
	    .tPackages.$l configure -background green
	    update
	    set res [ backExecW "make $t" .tPackages.progress.l2 1000 ]
	    incr i
	    if {$res == 0} {
		.tPackages.$l configure -background white
		.tPackages.msg.l1 configure -text "installed $i of $midPackagesN OCS packages"
	    } else {
		.tPackages.$l configure -background red
		break
	    }
	    update
	}
    }
    catch {destroy .tPackages.b.cancel}

    backExecONotify $res .tPackages.progress midPackagesDoAux "Installation completed successfully" "make $t failed with >$res<!"

    backExecOClose .tPackages.progress
    
}

proc midPackagesDoAux { res } {
    .tPackages.b.start configure -state normal
    catch {destroy .tPackages.b.cancel}
}

proc midPackagesCancel { } {
    global pid

    set x [catch {exec kill $pid} msg]
}

### Show Last Output
proc midShowLastOutput { } {
    if [file exists "/tmp/opalconfig.out" ] {
	showFile "Output of Last Command" "/tmp/opalconfig.out"
    } else {
	errorMsg "No output file found!"
    }
}

### Quit
proc midQuit { } { exit 0 }

## ======================================================================
# General procedures

## display error message
set errorCount 0
proc errorMsg { errorText } {
    global errorCount 

    set errorPathName ".errorMsg$errorCount"
    set errorCount [expr $errorCount + 1]
    toplevel $errorPathName
    message $errorPathName.cont -text $errorText -foreground red
    button $errorPathName.ok -text "OK" -command "destroy $errorPathName"
    pack $errorPathName.cont $errorPathName.ok
}

## named label

proc namedLabel {pathName boldText watchVar} {
    global fontbold $watchVar

    frame $pathName
    label $pathName.left -text $boldText -font $fontbold 
    label $pathName.right -textvariable $watchVar
    pack $pathName.left $pathName.right -side left
}

## named entry

proc namedEntry {pathName boldText watchVar} {
    global fontbold $watchVar

    frame $pathName
    label $pathName.left -text $boldText -font $fontbold 
    entry $pathName.right -textvariable $watchVar
    pack $pathName.left $pathName.right -side left
}

## execute command, save output of stdout and stderr in /tmp/opalconfig.out,
## return return code of command
## execution is done in background, which allows `after'-procedures to
## be performed

proc backExec { cmd } {
    global pid 
    
    set cmd "$cmd &> /tmp/opalconfig.out ; echo \$? > /tmp/opalconfig.res"
    set pid [ exec /bin/sh -c $cmd & ]
    set terminated 0
    while {! $terminated} {
	after 500
	set terminated [catch { exec ps $pid >& /dev/null } msg]
	update
    }
    set f [open "/tmp/opalconfig.res" "r"]
    set configError [read $f]
    close $f
    set configError [expr $configError + 0]
    return $configError
}

## additionally accept text widget name which is used to display the last
## line of the output

proc backExecW { cmd wgt delta } {
    global backExecProgress

    set backExecProgress 1
    after $delta backExecWAux $wgt $delta
    set res [ backExec $cmd ]
    set backExecProgress 0

    return $res
}

set backExecProgress 0
proc backExecWAux { wgt delta } {
  global backExecProgress

    if { $backExecProgress } {
	$wgt configure -text [exec tail -1 /tmp/opalconfig.out] -justify left
	update
	after $delta backExecWAux $wgt $delta
    }
}

## backExecO: put output in given frame

# prepare contents of frame
proc backExecOPrep { fr wid startmsg} {
    global fonttt

    label $fr.l -text "$startmsg" 
    label $fr.l2 -text " <output> " -font $fonttt -width $wid -justify left -anchor w
    pack $fr.l $fr.l2 -expand 1 -fill x 
    pack $fr -expand 1 -fill x 
    update
}

proc backExecONotify { err fr finally succmsg failmsg } {
    if $err {
	label $fr.l3 -text $failmsg -fg red
	button $fr.b -text "See output" -command "$finally $err; destroy $fr ; showFile { $failmsg } /tmp/opalconfig.out"
    } else {
	label $fr.l3 -text "$succmsg" 
	button $fr.b -text "OK" -command "$finally $err; destroy $fr"
    }
}

proc backExecOClose { fr } {
    pack forget $fr.l $fr.l2
    pack $fr.l3 -expand 1 -fill x -side left
    pack $fr.b -side left
}

## arguments: command to execute; frame where it is shown; milliseconds betwen updates; string displayed above progress line (activity); string used to construct result messages; procedure to call after termination; width in characters
proc backExecO { cmd fr delta startmsg notmsg finally wid } {

    backExecOPrep $fr $wid $startmsg
    set err [backExecW $cmd $fr.l2 $delta]

    backExecONotify $err $fr $finally "$notmsg succeeded!" "$notmsg failed!"

    backExecOClose $fr
    return $err
}

## show given file in separate toplevel window
## mark last line containing "error"
## initially show last line

set showFileCount 0
proc showFile {header filename} {
    global font2 showFileCount
    
    set showFilePathName ".showFile$showFileCount"
    incr showFileCount
    toplevel $showFilePathName
    wm title $showFilePathName $header
    label $showFilePathName.header -text $header -font $font2
    frame $showFilePathName.t
    text $showFilePathName.t.content -xscrollcommand "$showFilePathName.scrollx set" -yscrollcommand "$showFilePathName.t.scrolly set" -spacing3 3p
    scrollbar $showFilePathName.scrollx -command "$showFilePathName.t.content xview" -orient horizontal
    scrollbar $showFilePathName.t.scrolly -command "$showFilePathName.t.content yview" 
    set f [open $filename "r"]
    $showFilePathName.t.content insert end [read $f]
    close $f
    $showFilePathName.t.content see end
    set pos [$showFilePathName.t.content search -backwards -regexp "\[Ee\]rror" end]
    $showFilePathName.t.content tag configure errorTag -foreground red
    if {$pos != ""} {
	$showFilePathName.t.content tag add errorTag "$pos linestart" "$pos lineend"
    }
    button $showFilePathName.done -text Done -command "destroy $showFilePathName"
    pack $showFilePathName.t.content -side left -expand 1 -fill both
    pack $showFilePathName.t.scrolly -side top -expand 1 -fill y

    pack $showFilePathName.header 
    pack $showFilePathName.t -expand 1 -fill both
    pack $showFilePathName.scrollx -expand 1 -fill x
    pack $showFilePathName.done
}

## replace current frame with argument
proc replaceWorkFrame { new } {
    global currentWorkFrame

    if { $currentWorkFrame != ""} { destroy $currentWorkFrame }
    pack $new -in . -after .top
    set currentWorkFrame $new
}

## initialize for menu entry
proc initForMenuEntry { frameName headline } {
    global font2 

    frame $frameName -background white
    replaceWorkFrame $frameName

    label $frameName.headline -text $headline -font $font2 -background white
    pack $frameName.headline
}

######################################################################
#  finally initalize

midAbout

if { ! [file exists opalconfig.makeTargets] } {
        .mbar.action.menu entryconfigure 2 -state disabled
}
