#!/bin/sh
#
#	aegis - project change supervisor
#	Copyright (C) 1999 Peter Miller;
#	All rights reserved.
#
#	This program is free software; you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	the Free Software Foundation; either version 2 of the License, or
#	(at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	You should have received a copy of the GNU General Public License
#	along with this program; if not, write to the Free Software
#	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
#
# MANIFEST: tcl-tk aenc equivalent
#
#	Generated automatically from tkaenc.in by configure.
#
# comments wrap in Tcl, but not in sh \
exec wish $0 ${1+"$@"}

set bindir /usr/bin
set libdir /usr/bin
set datadir /usr/share/aegis

wm title . Aenc
wm iconname . Aenc
wm iconbitmap . @$datadir/aegis.icon
wm iconmask . @$datadir/aegis.mask

proc inform { arg } {
	.info.blurb insert end $arg
	.info.blurb see end
	.info.blurb insert end "\n"
	update
}

proc read_pipe { command errok } {
	set data ""
	set fd [open $command r]
	if { $fd != "" } {
		set data [read $fd]
		set codevar ""
		catch { close $fd } codevar
		if { $codevar != "" && !$errok } {
			inform [format "Command \"%s\"\nreturned \"%s\"" $command $codevar]
		}
	}
	return [string trim $data]
}

proc read_file { filename } {
	set data ""
	set fd [open $filename]
	if { $fd != "" } {
		set data [read $fd]
		set codevar ""
		catch { close $fd } codevar
		if { $codevar != "" } {
			inform [format "file %s error %s\"" $filename $codevar]
		}
	}
	return [string trim $data]
}

proc command_option_menu { w varName cmd firstValue args } {
	upvar #0 $varName var

	if {![info exists var]} {
		set var $firstValue
	}
	menubutton $w \
		-textvariable $varName \
		-indicatoron 1 \
		-menu $w.menu \
		-relief raised \
		-bd 2 \
		-highlightthickness 2 \
		-anchor c \
		-direction flush
	menu $w.menu -tearoff 0
	$w.menu add radiobutton -label $firstValue -variable $varName
	foreach i $args {
		$w.menu add radiobutton -label $i -variable $varName \
			-command $cmd
	}
	return $w.menu
}

proc project_drop_list { } {
	global project_name
	global project_list
	set x [winfo rootx .id.project.button]
	set y [winfo rooty .id.project.button]
	catch { destroy .popup } errcode
	toplevel .popup
	wm overrideredirect .popup 1
	wm geometry .popup +$x+$y
	listbox .popup.list -height 12 -selectmode single \
		-yscrollcommand ".popup.scroll set"
	set pos -1
	foreach pn $project_list {
		if { $pn == $project_name } { set pos [.popup.list size] }
		.popup.list insert end $pn
	}
	if { $pos >= 0 } {
		.popup.list selection set $pos
		.popup.list see $pos
	}
	scrollbar .popup.scroll -command ".popup.list yview"
	pack .popup.scroll -side right -fill y
	pack .popup.list -side left
	bind .popup.list <Double-Button-1> {
		set item [.popup.list curselection]
		if { $item != "" } { set item [.popup.list get $item] }
		if { $item != "" } {
			set project_name $item
			project_name_changed
		}
		destroy .popup
	}
}

proc project_name_changed { } {
	global project_name
	global datadir
}

#
# Create the widget heirarchy first
#	so the user has somethign to look at while we fetch
#	the necessary information.
#
frame .id
frame .id.project
label .id.project.label -text "Project:"
pack .id.project.label -side left
button .id.project.button -textvariable project_name -command project_drop_list
pack .id.project.button -side left
pack .id.project -side left
pack .id -side top -anchor w -pady 5

frame .bdesc
label .bdesc.label -text "Brief Description:"
pack .bdesc.label -side top -anchor w
text .bdesc.text -height 1
pack .bdesc.text -side bottom -fill x
pack .bdesc -fill x

frame .desc
label .desc.label -text "Description:"
pack .desc.label -side top -anchor w
text .desc.text -height 8 -yscrollcommand ".desc.scroll set" -wrap word -spacing3 5
scrollbar .desc.scroll -command ".desc.text yview"
pack .desc.scroll -side right -fill y
pack .desc.text -side bottom
pack .desc -fill x

frame .bottom

set test_nor 1
set test_bas 1
set test_reg 1

frame .bottom.tests -relief ridge -width 100 -borderwidth 2
label .bottom.tests.label -text "Testing Required:"
pack .bottom.tests.label -side top -anchor w
checkbutton .bottom.tests.normal -text "Normal (Positive)" -variable test_nor -onvalue 1 -offvalue 0
pack .bottom.tests.normal -side top -anchor w
checkbutton .bottom.tests.baseline -text "Baseline (Negative)" -variable test_bas -onvalue 1 -offvalue 0
pack .bottom.tests.baseline -side top -anchor w
checkbutton .bottom.tests.regression -text "Regression" -variable test_reg -onvalue 1 -offvalue 0
pack .bottom.tests.regression -side top -anchor w
pack .bottom.tests -side left -padx 5 -pady 5 -anchor nw

frame .bottom.control
button .bottom.control.ok -text "OK" -bg "#BFD0BF" -command "do_it"
pack .bottom.control.ok -fill x
button .bottom.control.cancel -text "Cancel" -command { exit 1 } -bg "#D0BFBF"
pack .bottom.control.cancel -fill x -pady 5
pack .bottom.control
pack .bottom.control -side right -padx 5

frame .bottom.cause -relief ridge -borderwidth 2
label .bottom.cause.label -text "Cause:"
pack .bottom.cause.label -side top -anchor w
radiobutton .bottom.cause.intbug -text "Internal Bug" -value "internal_bug" -variable cause -anchor w -command cause_changed
pack .bottom.cause.intbug -side top -anchor w
radiobutton .bottom.cause.intenh -text "Internal Enhancement" -value "internal_enhancement" -variable cause -anchor w -command cause_changed
pack .bottom.cause.intenh -side top -anchor w
radiobutton .bottom.cause.intimp -text "Internal Improvement" -value "internal_improvement" -variable cause -anchor w -command cause_changed
pack .bottom.cause.intimp -side top -anchor w
radiobutton .bottom.cause.extbug -text "External Bug" -value "external_bug" -variable cause -anchor w -command cause_changed
pack .bottom.cause.extbug -side top -anchor w
radiobutton .bottom.cause.extenh -text "External Enhancement" -value "external_enhancement" -variable cause -anchor w -command cause_changed
pack .bottom.cause.extenh -side top -anchor w
radiobutton .bottom.cause.extimp -text "External Improvement" -value "external_improvement" -variable cause -anchor w -command cause_changed
pack .bottom.cause.extimp -side top -anchor w
radiobutton .bottom.cause.chain -text "Chain Defect" -value "chain" -variable cause -anchor w -command cause_changed
pack .bottom.cause.chain -side top -anchor w
pack .bottom.cause -side left -anchor nw -pady 5

set start later
frame .bottom.start -relief ridge -borderwidth 2
label .bottom.start.label -text "Begin Development:"
pack .bottom.start.label -side top -anchor w
radiobutton .bottom.start.immed -text "Immediately" -value "aedb" -variable start -anchor w
pack .bottom.start.immed -side top -anchor w
radiobutton .bottom.start.later -text "Later" -value "later" -variable start -anchor w
pack .bottom.start.later -side top -anchor w
pack .bottom.start -side left -anchor nw -pady 5 -padx 5

pack .bottom -fill x

frame .info
text .info.blurb -height 3 -yscrollcommand ".info.scroll set" -wrap word -borderwidth 1
scrollbar .info.scroll -command ".info.blurb yview" -borderwidth 1
pack .info.scroll -side right -fill y
pack .info.blurb -side left
pack .info -side bottom -fill x

#
# This would be a good place to set a project template for change
# descriptions.
#
set brief_description "none"
set description "This change ..."
set cause "internal_bug"

#
# Ask Aegis for the list of projects names.  We use a specialized report
# script which emits TCL code to set the project_list variable.
#
inform "Reading list of projects..."
eval [read_pipe [format "|aereport -f %s/wish/proj_list.rpt -unf\
-pw=1000" $datadir] 0]
inform "   ...done"

#
# Set the project_name variable.  We need to ask Aegis for this, so that
# we get what *aegis* thinks is the default project name.
#
inform "Reading default project..."
set project_name [read_pipe "|aegis -list default_project" 1]
inform "   ...done"
if { $project_name == "" } { set project_name [lindex $project_list 0] }

.bdesc.text insert end $brief_description
.desc.text insert end $description

project_name_changed

proc do_it { } {
	global brief_description description cause
	global test_nor test_bas test_reg
	global project_name change_number start

	set filename [format "/tmp/tkaenc-%d" [pid]]
	set errcode ""
	catch { set fd [open $filename w 0600] } errcode
	if { $fd == "" } {
		inform [format "Open %s: %s" $filename $errcode]
		return
	}

	set brief_description [.bdesc.text get 1.0 end]
	set description [.desc.text get 1.0 end]
	set tmp $brief_description
	regsub -all {[\\"]} $tmp {\\&} tmp
	regsub -all \n $tmp \\n\\\n tmp
	puts $fd [format "brief_description = \"%s\";" $tmp]
	set tmp $description
	regsub -all {[\\"]} $tmp {\\&} tmp
	regsub -all \n $tmp \\n\\\n tmp
	puts $fd [format "description = \"%s\";" $tmp]
	puts $fd [format "cause = %s;" $cause]
	if { $test_nor } then { puts $fd "test_exempt = false;" } else { puts $fd "test_exempt = true;" }
	if { $test_bas } then { puts $fd "test_baseline_exempt = false;" } else { puts $fd "test_baseline_exempt = true;" }
	if { $test_reg } then { puts $fd "regression_test_exempt = false;" } else { puts $fd "regression_test_exempt = true;" }
	close $fd

	inform [format "Creating project %s change..." $project_name]
	set command [list aegis -nc -f $filename -p $project_name -o $filename.o]
	inform [format "Command = \"%s\"" $command]
	set errcode ""
	set errorCode 0
	catch { eval exec $command } errcode
	if { $errorCode != 0 } {
		catch { exec [format "rm %s %s.o" $filename $filename] } errcode2
		inform $errcode
		return
	}
	set change_number [read_file $filename.o]
	catch { exec [format "rm %s %s.o" $filename $filename] } errcode2
	puts [format "tkaenc: project \"%s\": change %d: created" $project_name $change_number]

	if { $start != "later" } {
		set command [list aegis -db -p $project_name -c $change_number]
		inform [format "Command = \"%s\"" $command]
		set errcode ""
		set errorCode 0
		catch { eval exec $command } errcode
		if { $errorCode != 0 } {
			catch { exec [format "rm %s" $filename] } errcode2
			puts [format "tkaenc: project \"%s\": change %d: development not begun" $project_name $change_number]
			puts $errcode
			exit 1
		} else {
			puts [format "tkaenc: project \"%s\": change %d: development begun" $project_name $change_number]
		}
	}

	exit 0
}

proc cause_changed { } {
	global cause
	global test_nor
	global test_bas
	global test_reg

	if { $cause == "internal_improvement" || $cause == "external_improvement" } {
		set test_nor 0
		set test_bas 0
		set test_reg 1
	} {
	if { $cause == "internal_enhancement" || $cause == "external_enhancement" } {
		set test_nor 0
		set test_bas 1
		set test_reg 1
	} {
		set test_nor 1
		set test_bas 1
		set test_reg 0
	} }
}
