#!/bin/sh
#
# $Id: tkeditpr,v 1.16 1993/08/05 04:42:23 mh Exp $
#

### this section is configured by the Makefile 
GNATS_ROOT=/usr/local/gnats; ##GNATS_ROOT##
LIBDIR=/usr/local/lib; ##LIBDIR##
###

PR_EDIT=$LIBDIR/gnats/pr-edit

error () {
    2>&1 echo "$*"
}

### get full id of pr
if [ "$1" = "" ]; then
    msgDialog "tkeditpr: no PR id supplied" "Usage:	tkeditpr <PR id>"
    exit 1
fi
case "$1" in
*/*)
    full_id=$1
    ;;
*)
    full_id=`grep "/$1:" $GNATS_ROOT/gnats-adm/index | awk -F: '{print $1}' -`
    ;;
esac
shift

pr=$GNATS_ROOT/$full_id
if [ "$full_id" = "" ]; then
  error "tkeditpr: file not found" ;
  exit 1
else
  if [ ! -f $pr -o ! -r $pr ]; then
    error "tkeditpr: cannot read PR $full_id"
    exit 1
  fi
fi

### find a username@hostname
if [ "$USER" != "" ]; then
  me=$USER
else
  if [ "$LOGNAME" != "" ]; then
    me=$LOGNAME
  else
    msgDialog "tkeditpr: no user name found set LOGNAME." ; exit 1
  fi
fi
if [ -z "$HOSTNAME" ]; then
  if [ -f /bin/hostname ] ; then HOSTNAME=`/bin/hostname`
  elif [ -f /usr/bin/hostname ] ; then HOSTNAME=`/usr/bin/hostname`
  # Solaris et al.
  elif [ -f /usr/ucb/hostname ] ; then HOSTNAME=`/usr/ucb/hostname`
  # Irix
  elif [ -f /usr/bsd/hostname ] ; then HOSTNAME=`/usr/bsd/hostname`
  fi
fi
if [ -n "$HOSTNAME" ]; then
  me="$me@$HOSTNAME"
fi

###

### do some traps before we start to make sure the pr gets unlocked
### if something goes wrong
locked=
trap 'rm -f /tmp/u$$ $new ; exit 0' 0
trap 'if [ "$locked" != "" ]; then \
	$PR_EDIT --unlock $full_id ; \
		locked= ; \
      fi ; \
	rm -f /tmp/u$$; exit 1' 1 2 3 13 15

### lock a copy of the PR
new=/tmp/ep$$
cp $pr $new
$PR_EDIT --lock $me $full_id 2> /tmp/u$$
locked=t

### if the lock failed bail out
if [ -s /tmp/u$$ ]; then
  if [ "`grep exists /tmp/u$$`" = "" ]; then
    msgDialog "tkeditpr: PR $full_id is locked by `sed 's/.*by //g' /tmp/u$$`"
  else
    msgDialog "tkeditpr: GNATS is presently locked, try again in a moment"
  fi
  rm -f /tmp/u$$
  exit 1
fi

#################### start of the wish section ########################

wish $* $full_id $new <<\__EOF__

### this section is configured by the Makefile
set TkGnats(lib) ./; ##TKGNATSLIB##
###

foreach f { tkpr_library.t } {
    source $TkGnats(lib)/$f
}

proc Msg {args} {
    eval exec msgDialog [wm title .] "" $args &
    schedule_reap
}

case $TkGnats(LogName) {root} {
    Msg "You cannot edit problem reports as root." "Use your own login"
    Exit 1
}

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

set Tkeditpr(radioflds) {
    >State
    >Confidential
    >Severity
    >Priority
    >Class
}

proc chk_fld {fldname val {flag_if_missing 1}} {
    upvar 1 $fldname fld
    set mlist {}
    if {![info exists fld]} {
	if {$flag_if_missing} {
	    append mlist $fldname
	}
	set fld $val
    }
    return $mlist
}
proc load_field_defaults {field_array} {
    upvar 1 $field_array field
    chk_fld field(>State)		open
    chk_fld field(>Confidential)	no
    chk_fld field(>Severity)		serious
    chk_fld field(>Priority)		medium
    chk_fld field(>Class)		sw-bug
    chk_fld field(>Arrival-Date)	[exec date]
    chk_fld field(>Originator)		Unknown
    chk_fld field(>Responsible)		gnats
    chk_fld field(>Category)		pending
    chk_fld field(>Synopsis)		None
    chk_fld field(>Release)		Unknown
    chk_fld field(>Description)		None
    chk_fld field(>Environment)		"\n"
    chk_fld field(>Audit-Trail)		"\n"
    chk_fld field(>How-To-Repeat)	"\n"

    # It's ok if these are missing
    chk_fld field(>Unformatted)		"\n" 0
    chk_fld field(>X-Journal)		"\n" 0
}

set Tkeditpr(singletextflds) {
    >Responsible
    >Release
    >Synopsis
}
set Tkeditpr(multitextflds) {
    >Description
    >X-Journal
    >How-To-Repeat
    >Environment
    >Audit-Trail
    >Unformatted
}

proc merge_into_list {lname new_value} {
    upvar 1 $lname l
    if {[lsearch $l $new_value]<0} {
	set l "$l $new_value"
    }
}

proc file_report {} {
    global Tkeditpr TkGnats frm flds errorCode
    flush_txt

    #
    # do some local field checking..
    #
    headingMsg "Checking fields.." 0
    # - Check Responsible field..
    if {"[get_passwd_entry [textget >Responsible]]" == ""} {
	Msg "'[textget >Responsible]' is not a valid user"
	return -1
    }
    # - Check that indexed text fields do not have a | char. (hoses tkquerypr)
    foreach t {>Release >Synopsis} {
	if {[string first "|" [textget $t]] != -1} {
            Msg " '|' is an illegal character for the '$t' field"
            return -1
	}
    }
    foreach t {>Environment} {
	if {[string first "|" $frm($t)] != -1} {
            Msg " '|' is an illegal character for the '$t' field"
            return -1
	}
    }

    #
    # now see if any fields changed that trigger notifiers or audit records
    #
    # >Synopsis
    set mail_list ""
    set all_changes ""
    set datestr [exec date]
    set responsible_addr [my_pr_addr $frm(>Responsible)]
    set old_responsible_addr [my_pr_addr $flds(>Responsible)]
    set originator_addr $flds(Reply-To)

    set t ">State"
    if {$frm($t) != $flds($t)} {

	set change_msg	"\n\nState-Changed-From-To: $flds($t)-$frm($t)\n"
	append change_msg	"State-Changed-By: $TkGnats(LogName)\n"
	append change_msg	"State-Changed-When: $datestr\n"
	append change_msg	"State-Changed-Why: \n"

	append all_changes $change_msg 

	# if the new responsible person is not us then mail to them
	# the status change
	if {$TkGnats(LogName) != $responsible_addr} {
	    merge_into_list mail_list $responsible_addr
	}
	if {$TkGnats(LogName) != $originator_addr} {
	    merge_into_list mail_list $originator_addr
	}
    }

    set t ">Responsible"
    if {$frm($t) != $flds($t)} {

	merge_into_list mail_list $originator_addr

	# if the old responsible person is not us then mail to them
	if {$TkGnats(LogName) != $old_responsible_addr} {
	    # if they are not already in the list of course
	    merge_into_list mail_list $old_responsible_addr
	}
	# if the new responsible person is not us then mail to them
	if {$TkGnats(LogName) != $responsible_addr} {
	    merge_into_list mail_list $responsible_addr
	}
	if {$TkGnats(LogName) != $originator_addr} {
	    merge_into_list mail_list $originator_addr
	}

	set change_msg "\n\nResponsible-Changed-From-To: $flds($t)->$frm($t)\n"
	append change_msg	"Responsible-Changed-By: $TkGnats(LogName)\n"
	append change_msg	"Responsible-Changed-When: $datestr\n"
	append change_msg	"Responsible-Changed-Why: \n"

	append all_changes $change_msg 
    }

    #
    # did any notifiable changes take place ??
    #
    if {"$all_changes" != ""} {
	set x [catch {
	    if {"$mail_list" != ""} {
		set fout [open "|$TkGnats(Mailer) $mail_list" w]
		puts $fout "To: $mail_list"
		puts $fout "From: $TkGnats(LogName)"
		puts $fout "Subject: Changed information for PR $Tkeditpr(prid)"
		puts $fout $all_changes nonewline
		flush $fout
	    }
	} errs]
	if {$x} {
	    Msg "Error mailing notifiers to <$mail_list> :" "\n$errs"
	}
	append frm(>Audit-Trail) $all_changes
    }

    #
    # Now check the X-Journal entry. If it is different, tack a new
    # timestamp on the end..
    #
    if {$frm(>X-Journal) != $flds(>X-Journal)} {
	append frm(>X-Journal) \
	    "\n%${datestr}%$TkGnats(LogName)%[fullname_from_logname]%\n"
	fullname_from_logname
    }

    headingMsg "Filing report.." 0

    set tmpfile "/tmp/prfile.[exec date +%T]"
    set fout [open  $tmpfile w]
    write_pr $fout
    close $fout

    set errs ""
    set x [catch "exec $TkGnats(pr-edit) --check < $tmpfile" errs]
    ## "$errs" != ""
    if {0}  {
	Msg "Error checking $tmpfile:" "$errs" "$errorCode"
    } else {
	if {[catch "exec $TkGnats(pr-edit) < $tmpfile" errs]} {
	    Msg "Error filing $tmpfile:" "$errs"
	} else {
	    headingMsg "Done" 0
	    exec rm -f $tmpfile
	    Exit 0
	}
    }
    exec rm -f $tmpfile
}

proc write_multitextfld {fout flds tag} {
    upvar 1 $flds f
    puts $fout [string trimleft "$tag: \n[string trim $f($tag) "\n"]" "\n"]
}

proc write_pr {fout} {
    global Tkeditpr flds frm

    foreach tag [array names frm] {
	set still_left($tag) $tag
    }

    #
    # for each parsed field from the PR form...
    #
    foreach tag $Tkeditpr(parsed_flds) {
	case $tag {_prefix_} {
	    #
	    #	The mail header, stored under the _prefix_ tag, is written out
	    #	unadulterated.
	    #
	    puts $fout $flds($tag) nonewline
	} {>Unformatted} {
	    #
	    # Taken care of later in the function..
	    #
	} {>*} {
	    # When writing out the fields
	    #	first check for data present in the form (the frm bag)
	    #	If not present use data read from the PR file (the flds bag)
	    #
	    if {[info exists frm($tag)]} {
		set data $frm($tag)
		unset still_left($tag)
	    } else {
		set data $flds($tag)
	    }

	    #
	    # Write out fields
	    #
	    #	Multi line fields are newline trimmed to a single leading
	    #	and trailing newline
	    #
	    #	Single line text fields are whitspace trimed to a leading
	    #	tab and a trailing newline
	    #
	    case $tag $Tkeditpr(singletextflds) {
		puts $fout "$tag:\t[string trim [textget $tag] "\t\n "]"
	    } [concat >Category $Tkeditpr(radioflds)] {
		puts $fout "$tag:\t$frm($tag)"
	    } $Tkeditpr(multitextflds) {
		write_multitextfld $fout frm $tag
	    } default {
		puts $fout "$tag:$data" nonewline
	    }
	}
    }

    #
    # now write any fields in the form that were not in the parsed report
    #
    foreach tag [array names still_left] {
	write_multitextfld $fout frm $tag
    }

    #
    # Finally, write the >Unformatted field
    #   (BUG: >Unformatted should not really be stripped)
    #
    write_multitextfld $fout frm ">Unformatted"
}



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

proc edit_category_listbox {p {pat *}} {
    global frm(>Category)
    set frm(>Category) ""

    frame $p.cat -relief sunken -borderwidth 2
    pack append $p $p.cat {top expand fill}
    message $p.cat.msg -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 1 \
		-geometry 20x6
    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_edit_category $p.cat.msg %W %y"
    return $p.cat.list
}

proc set_edit_category {msg w y} {
    global frm
    set idx [$w nearest $y]
    set frm(>Category) [$w get $idx]
    $msg configure -text "Category: $frm(>Category)"
}

proc make_txt_mb {} {
    global Tkeditpr
    menubutton .mb  -relief raised  -text "Text: " -menu .mb.m -underline 0
    menu .mb.m
    foreach x $Tkeditpr(multitextflds) {
	set lbl [string trimleft $x >]
	.mb.m add command -label $lbl -command "switch_txt $x"
    }

    set f [frame .multiline]
    set q [text $f.text \
	-yscrollcommand "$f.sb set" \
	-height 8 -width 80 -relief sunken -padx 4 -insertwidth 1 \
	-insertofftime 400 -borderwidth 2 ]

    bind $f.text <Enter> "+focus $f.text"
    scrollbar $f.sb -command "$f.text yview" -relief sunken
    pack append $f \
	$f.sb {left filly} \
	$f.text {right expand fill}
    pack append . \
	.mb {top frame w} \
	$f {top padx 32 pady 4 expand fill}
}

set current_multi_text ""
proc flush_txt {} {
    global current_multi_text frm flds Tkeditpr
    set f .multiline
    if {"$current_multi_text" != ""} {
	set frm($current_multi_text) [$f.text get 1.0 end]
    }
    foreach tag $Tkeditpr(singletextflds) {
	set frm($tag) [string trim [textget $tag] "\t\n "]
    }
}

proc switch_txt {name} {
    global current_multi_text frm flds
    set f .multiline

    # write the current text out back into the frm bag
    flush_txt

    set current_multi_text $name

    # load the text widget with the new text
    $f.text delete 1.0 end
    $f.text insert 1.0 $frm($name)

    # reset the label
    .mb configure -text "Text: [string trimleft $name >]"
}

proc sanity_check {fields} {
}

set Tkeditpr(prid) [lindex $argv 0]
if {$Tkeditpr(prid) == ""} {
    Msg "missing prid argument"
    Exit -1
}
set Tkeditpr(srcfile) [lindex $argv 1]
if {"$Tkeditpr(srcfile)" == ""} {
    Msg "missing srcfile argument"
    Exit -1
}

# load a bunch of defaults into flds.

set fin [open "|query-pr --full $Tkeditpr(prid)" r]
set Tkeditpr(parsed_flds) [parsepr $fin flds]
set missing_list [load_field_defaults flds]
close $fin
if {"$missing_list" != ""} {
    Msg "The following fields were missing in the PR" "$missing_list"
    set Tkeditpr(parsed_flds) [concat $Tkeditpr(parsed_fields) $missing_list]
}

message .msg -aspect 99999 -text ""
label .hdr  -text [format "%s%s" \
    "PR No. [ftrim $flds(>Number)]. Originator: [ftrim $flds(>Originator)]  " \
    "( Email: $flds(Reply-To) )"]

pack append . .msg {fillx padx 4 pady 8}
pack append . .hdr {fillx padx 4}

wm title . "PR form [ftrim $flds(>Number)]"
wm iconname . "tkeditpr $flds(>Number)"

readonly_singletext Confidential $flds(>Confidential)
readonly_singletext Arrival-Date $flds(>Arrival-Date)

frame .eflds
radiobar_frame .eflds .eflds.lb
bagged_radiobar .eflds.lb state "State" \
    {open analyzed feedback closed suspended} None frm
bagged_radiobar .eflds.lb confidential "Confidential" \
    {no yes} None frm 
bagged_radiobar .eflds.lb severity Severity \
    {non-critical serious critical} None frm 
bagged_radiobar .eflds.lb priority Priority \
    {low medium high} None frm 
bagged_radiobar .eflds.lb class Class \
    {sw-bug doc-bug change-request support mistaken duplicate} None frm 


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

singletext >Responsible 40 
singletext >Release 80 
singletext >Synopsis 80

make_txt_mb

frame .action -relief raised -borderwidth 3 -background gray
button .action.cancel -borderwidth 1 -text "Cancel" -command cancel_report
button .action.send -borderwidth 1 -text "File" -command file_report

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

pack append . \
    .action {top pady 12}

proc fillfrm {} {
    global frm flds Tkeditpr
    ### pre-set editable PR values to values currently in the PR
    # radio (enumerated) fields
    foreach tag [concat >Category $Tkeditpr(radioflds)] {
	set flds($tag) [string trim $flds($tag) "\t\n "]
	set frm($tag) $flds($tag)
    }
    .eflds.clb.cat.msg configure -text "Category: $frm(>Category)"
    # now the 1 line textual flds
    foreach tag $Tkeditpr(singletextflds) {
	set flds($tag) [string trim $flds($tag) "\t\n "]
	textset $tag $flds($tag)
    }
    # now the multi line textual flds
    foreach tag $Tkeditpr(multitextflds) {
	if {[info exists  flds($tag)]} {
	    set $flds($tag) [string trim $flds($tag) "\n"]
	    set frm($tag) $flds($tag)
	} else {
	    set frm($tag) "\n"
	    set flds($tag) "\n"
	}
    }
    switch_txt ">Description"
}

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


proc headingMsg {a {flash 1}} {
    .msg configure -text $a; update
    if {$flash} {
	foreach rep {1 2 3 4 5} {
	    foreach r {raised sunken flat} {
		.msg configure -relief $r;
		update idletasks
		after 50
	    }
	}
    }
}


__EOF__

#
# end of tcl script, We are back into /bin/sh land at this point
#
$PR_EDIT --unlock $full_id

#
# If needed. unlock the file here...
#
