#!/usr/local/bin/wish -file

#
# $Id: tksendpr,v 1.17 1993/09/13 20:50:13 mh Exp $
#


set TkGnats(lib) ./; ##TKGNATSLIB##
foreach f { tkpr_library.t } {
    source $TkGnats(lib)/$f
}

proc Msg {args} {
    eval exec msgDialog "tksendpr" $args &
    schedule_reap
} 

switch -exact -- $TkGnats(LogName) {root} {
    Msg "You cannot send problem reports as root. Use your own login"
    Exit 1
}

# The default release for this host.
set DEFAULT_RELEASE "_release_"
set USER_GNATS_SITE $TkGnats(GNATS_SITE); ## may get from elsewhere later..

#########

set HOSTNAME [exec hostname]

set FROM [set TkGnats(LogName)]@$HOSTNAME
set REPLY_TO [set TkGnats(LogName)]@$HOSTNAME

set ORGANIZATION $TkGnats(Submitter-Id)
if { [info exists env(ORGANIZATION)] } {
    if { [file readable $env(ORGANIZATION)] } {
	set ORGANIZATION [exec cat < $env(ORGANIZATION)]
    } else {
	set ORGANIZATION $env(ORGANIZATION)
    }
} else {
    if { [file readable $env(HOME)/.signature] } {
	set ORGANIZATION [exec cat < $env(HOME)/.signature]
    }
}

# Find out some information.
set SYSTEM "_system_"
set ARCH "_arch_"
set MACHINE "_machine_"

if { [info exists env(TMPDIR)] } {
    set TMPDIR $env(TMPDIR)
} else {
    set TMPDIR /tmp
}

set stamp [exec whoami][exec date +%j:%T]
set TEMP $TMPDIR/p$stamp
set BAD $TMPDIR/pbad$stamp
set REF $TMPDIR/pf$stamp
set COMMAND tksendpr
set USAGE "Usage: $COMMAND"

set REMOVE ""
set VERSION 3.00

## TBD
## --- may want to check SUBMITTER validity here ...
## TBD

set CategoryList [get_categories]
if {$CategoryList == ""} {
  Msg "$COMMAND: the categories list was empty!"
  Exit 1
}

message .msg -aspect 9999 \
	-text "PR form for [fullname_from_logname] '$FROM'"

pack append . .msg {top fillx padx 4 pady 20}

proc headingMsg {a} {
    .msg configure -text $a; update
}

# Assemble the problem report in gnats format from the fields in
# Before assembly some of the widgets are checked for validity.
proc send_report {} {
    global stamp TkGnats
    # check all the fields first...
    foreach v {
	Confidential Severity Priority Class Category
    } {
	global $v
	switch -exact -- [set $v] "" {
	    Msg "An option from '$v' must be selected"
	    return -1
	}
    }
    foreach t {
	Originator Synopsis Description How-To-Repeat 
    } {
	set x [textget $t]
	set x [string trim $x " \n\t\f!:~-#_?"]
	# If a change request, don't demand a How-To-Repeat
	if {$t == "How-To-Repeat"} {
	    global Class
	    if {$Class == "change-request"} {
		continue
	    }
	}
	switch -exact --  $x "" {
	    Msg "Field '$t' is not complete. Type something descriptive in."
	    return -1
	}
    }
    foreach t {
	Originator Release Synopsis Environment
    } {
	if {[string first "|" [textget $t]] != -1} {
	    Msg " '|' is an illegal character for the '$t' field"
	    return -1
	}
    }

    # ok, now send off the report

    set tmpfilename /tmp/tksendpr.$stamp
    set fout [open $tmpfilename "w"]
    global FROM REPLY_TO ORGANIZATION VERSION
    puts $fout "To: $TkGnats(GNATS_ADDR)"
    puts $fout "Subject: "
    puts $fout "From: $FROM"
    puts $fout "Reply-To: $REPLY_TO"
    puts $fout "X-send-pr-version: $VERSION"
    puts $fout ""
    #### End of std mail headers

    puts $fout ">Submitter-Id: $TkGnats(Submitter-Id)"
    puts $fout ">Organization: \n$ORGANIZATION"
    foreach v {
	Confidential Severity Priority Category Class
    } {
	puts $fout ">${v}:	[set $v]"
    }

    foreach t {
	Synopsis Originator Release 
	Environment Description How-To-Repeat 
    } {
	puts $fout ">${t}: [textget $t]"
    }

    close $fout
    send_off $tmpfilename

    #
    # clear out some fields
    #
    foreach t {
	Synopsis Environment Description How-To-Repeat 
    } {
	textset $t ""
    }
    return 0
}

proc send_report_and_exit {} {
    if {[send_report] == 0} {
	Exit 0
    }
}

# mail the assembled problem report file to the gnats system
proc send_off {fname} {
    global TkGnats FROM
    headingMsg "Sending Report to $TkGnats(GNATS_ADDR).."
    exec $TkGnats(Mailer) $TkGnats(GNATS_ADDR) < $fname
    exec rm $fname
    headingMsg "Done"
    after 500 
    headingMsg "PR form for [fullname_from_logname] '$FROM'"
    return ""
}

# bail out completely
proc cancel_report {} {
    Exit 0
}

proc snd_category_listbox {p {pat *}} {
    global Category
    set Category ""

    frame $p.cat
    pack append $p $p.cat {top expand fill}
    message $p.cat.msg -anchor w -text Category: -aspect 10000
    scrollbar $p.cat.sb -command "$p.cat.list yview" -borderwidth 2 \
		-relief sunken
    listbox $p.cat.list -yscroll "$p.cat.sb set" -setgrid 1 \
		-relief sunken -borderwidth 2 \
		-geometry 20x4
    eval $p.cat.list insert end [get_categories $pat]
    pack append $p.cat \
		$p.cat.msg {top fillx} \
		$p.cat.sb {left filly} \
		$p.cat.list {right expand fill}
    tk_listboxSingleSelect $p.cat.list
    bind $p.cat.list <B1-ButtonRelease> "set_snd_category $p.cat.msg %W %y"
    return $p.cat.list
}

proc set_snd_category {msg w y} {
    global Category
    set idx [$w nearest $y]
    set Category [$w get $idx]
    $msg configure -text "Category: $Category"
}

frame .eflds
radiobar_frame .eflds .eflds.lb
radiobar .eflds.lb confidential "Confidential" {no yes} None
radiobar .eflds.lb severity Severity {non-critical serious critical} None
radiobar .eflds.lb priority Priority {low medium high} None
radiobar .eflds.lb class Class {sw-bug doc-bug change-request support} None

frame .eflds.clb 
snd_category_listbox .eflds.clb
pack append .eflds .eflds.lb {left} .eflds.clb {right padx 8}
pack append . .eflds {top fillx}

set tlist {}
lappend tlist [singletext Originator 80 [fullname_from_logname]]
lappend tlist [singletext Release 80]
lappend tlist [singletext Synopsis 80]
lappend tlist [multitext Environment 3]
lappend tlist [multitext Description 8]
lappend tlist [multitext How-To-Repeat 8]
set_text_traversal $tlist

frame .action -relief raised -borderwidth 3 -background gray
button .action.cancel -borderwidth 1 -text "Cancel" -command cancel_report
button .action.send -borderwidth 1 -text "Send" -command send_report
button .action.sendandexit -borderwidth 1 -text "Send and Exit" \
	-command send_report_and_exit

pack append .action \
    .action.cancel {left pady 8 padx 40} \
    .action.send {right pady 8 padx 40} \
    .action.sendandexit {right pady 8 padx 40}

pack append . \
    .action {top pady 12}

wm iconbitmap . @$TkGnats(lib)/tksendpr.xbm
wm iconname . $env(LOGNAME)
