#!/usr/local/bin/wish

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

# Set Create Defaults
foreach d { {Class sw-bug} {Priority medium} {Severity serious} {Confidential no} } {
    if {![info exists TkGnats(CreateDefault[lindex $d 0])]} {
        set TkGnats(CreateDefault[lindex $d 0]) [lindex $d 1]
    }
}

# List of entry widgets for traverse key binding
set Tksendpr(tlist) {}

set Tksendpr(singletextflds) {
    Originator
    Release
    Synopsis
    Reply-To
}

if {$TkGnats(ReleaseBased)} {
    lappend Tksendpr(singletxtflds) Keywords
}

proc tksendpr_process_args {} {
    global argc argv CategoryList TkGnats
    if {$argc != 0} {
	if {$argc%2 != 0} {
	    tkerror "illegal syntax"
	}
    }
    set addressval ""
    for {set x 0} {$x<$argc} {incr x 2} {
	set opt [lindex $argv $x]
	set val [lindex $argv [expr $x+1]]
	switch -exact -- $opt -categories {
	    set CategoryList $val
	} -site {
	    set TkGnats(GNATS_SITE) $val
	    set TkGnats(GNATS_ADDR) $TkGnats(GNATS_SITE)-gnats
	} -address {
	    set addressval $val
	} default {
	    tkerror "illegal option pair '$opt $val'"
	}
    }
    if {"$addressval" != ""} {
	set TkGnats(GNATS_ADDR) $val
    }
}

if {"$TkGnats(LogName)" == "root"} {
    Msg "You cannot send problem reports as root.\n" "Please use your own login."
    Exit 1
}

tksendpr_process_args

# The default release for this host.
set DEFAULT_RELEASE "_release_"

#########

set FROM     [set TkGnats(EmailAddr)]
set REPLY_TO [set TkGnats(EmailAddr)]

set ORGANIZATION $TkGnats(Submitter-Id)
if { [info exists env(ORGANIZATION)] } {
    if { [file readable $env(ORGANIZATION)] } {
	set ORGANIZATION [file_get_text $env(ORGANIZATION)]
    } else {
	set ORGANIZATION $env(ORGANIZATION)
    }
} else {
    if { [file readable $env(HOME)/.signature] } {
	set ORGANIZATION [file_get_text $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   $TkGnats(LogName)[clock format [clock seconds] -format "%j:%T"]
set TEMP    $TMPDIR/p$stamp
set BAD     $TMPDIR/pbad$stamp
set REF     $TMPDIR/pf$stamp

set REMOVE  ""
set VERSION 3.102

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

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

if {![info exists SubmitterList]} {
    set SubmitterList [get_submitters] 
    if {$SubmitterList == ""} {
	Msg "The submitters list is empty!"
	Exit 1
    }
}

frame   .mframe -borderwidth 1 -relief raised
pack    .mframe -side top -fill x
message .mframe.msg -aspect 10000 -text ""
pack    .mframe.msg -side left -fill x

menubutton .mframe.help -text "Help" -menu .mframe.help.m -underline 0
menu       .mframe.help.m
.mframe.help.m add command -label "Overview" \
        -command "helpMsg Create_Overview"
.mframe.help.m add separator
.mframe.help.m add command -label "Field Definitions" \
        -command "helpMsg Field_Definitions"
.mframe.help.m add separator
.mframe.help.m add command -label "Radio Buttons (Class, etc)" \
        -command "helpMsg Create_Radio_Buttons"
.mframe.help.m add command -label "Listbox Selectors (Category, etc)" \
        -command "helpMsg Create_Listbox_Selectors"
.mframe.help.m add command -label "Entry Fields (Originator, etc)" \
        -command "helpMsg Create_Entry_Fields"
.mframe.help.m add command -label "Text Fields (Description, etc)" \
        -command "helpMsg Create_Text_Fields"
.mframe.help.m add separator
.mframe.help.m add command -label "About" \
        -command "helpMsg TkGnats_Version"
pack .mframe.help -side right

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

# 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 frm Tksendpr CategoryList SubmitterList
    
    flush_singletext $Tksendpr(singletextflds)
    flush_multitext
    
    # check all the fields first...

    foreach v {
	Confidential Severity Priority Class Category Submitter
    } {
	global $v
	switch -exact -- [set $v] "" {
	    Msg "An option from '$v' must be selected."
	    return -1
	}
    }

    if {[lsearch -exact $CategoryList $Category] < 0} {
        Msg "You have specified an invalid Category!"
        return -1
    }
        
    if {[lsearch -exact $SubmitterList $Submitter] < 0} {
        Msg "You have specified an invalid Submitter-Id!"
        return -1
    }
     
    foreach t {
	Originator Synopsis Reply-To Description How-To-Repeat 
    } {
	if {$t == "Description" || $t == "How-To-Repeat"} {
            set x $frm(>$t)
        } {
            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.\n" "Type in something descriptive."
	    return -1
	}
    }

    set flist {
	Originator Release Synopsis Reply-To Environment
    }

    if {$TkGnats(ReleaseBased)} {
	lappend flist Keywords
    }
    
    foreach t $flist {
	if {$t == "Environment"} {
            set x $frm(>$t)
        } {
            set x [textget $t]
        }
	if {[string first "|" $x] != -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: [string trim [textget Synopsis]]"
    puts $fout "From: $FROM"
#    puts $fout "Reply-To: $REPLY_TO"
    puts $fout "Reply-To: [string trim [textget Reply-To]]"
    puts $fout "X-send-pr-version: $VERSION"
    puts $fout "\n"
    #### End of std mail headers

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

    set flist {
	Synopsis Originator Release 
    }
    
    if {$TkGnats(ReleaseBased)} {
	lappend flist Keywords
    }
    
    foreach t $flist {
	puts $fout ">${t}: [textget $t]"
    }

    foreach t {
	Environment Description How-To-Repeat Fix
    } {
	puts $fout ">${t}:\n$frm(>$t)"
    }

    close $fout
    send_off $tmpfilename

    #
    # clear out some fields
    #

    set flist {
	Synopsis
    }

    if {$TkGnats(ReleaseBased)} {
	lappend flist Keywords
    }

    foreach t $flist {
	textset $t ""
    }
    
    foreach t {
	Environment Description How-To-Repeat Fix
    } {
	set frm(>$t) ""
    }
    .multiline.text delete 1.0 end
    switch_txt ">Description" $Tksendpr(multitextflds)
    # Some folks may not want this reset
    set frm(>Environment) [env_fld_text]
    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
#    eval exec $TkGnats(Mailer) $TkGnats(GNATS_ADDR) < $fname
    set code [catch {eval exec $TkGnats(Mailer) < $fname} result]
    file delete $fname
    headingMsg "Sending Report to $TkGnats(GNATS_ADDR)...Done"
#####    after 500 
#####    headingMsg ""
    return ""
}

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

proc snd_category_listbox {p category_list} {
    global Category Tksendpr Category_wid
    set Category ""

    frame  $p.cat -relief groove  -borderwidth 2
    pack   $p.cat -side top -expand true -fill both
    button $p.cat.msg -anchor w -text "Category: " -width 14 -command "helpMsg Category" \
            -relief flat -padx 0 -pady 0 -borderwidth 0
    set Category_wid [expr 2 + [get_max_strlen $category_list]]
    set ew [entry  $p.cat.ent -width $Category_wid -insertwidth 1 -insertofftime 400 \
            -relief sunken -borderwidth 2 -background grey95 -textvariable Category]
    lappend Tksendpr(tlist) $ew
    trace variable Category w set_snd_category_ew
    bind $ew <Enter> "+focus $ew"
    set height [llength $category_list]
    if {$height > 6 } {
        set height 6
    }
    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 \
            -width $Category_wid -height $height -exportselection false
    eval   $p.cat.list insert end $category_list
    pack   $p.cat.msg  -side left  -anchor n
    pack   $p.cat.ent  -side left  -anchor n
    pack   $p.cat.sb   -side left  -fill y
    pack   $p.cat.list -side right -fill both -expand true
    bind   $p.cat.list <B1-ButtonRelease> "set_snd_category $p.cat.ent %W %y"
    return $p.cat.list
}

proc snd_submitter_listbox {p submitters_list} {
    global Submitter Tksendpr Category_wid
    set Submitter ""

    frame  $p.sub -relief groove  -borderwidth 2
    pack   $p.sub -side top -expand true -fill both
    button $p.sub.msg -anchor w -text "Submitter-Id: " -width 14 -command "helpMsg Submitter-Id" \
            -relief flat -padx 0 -pady 0 -borderwidth 0
    set wid [expr 2 + [get_max_strlen $submitters_list]]
    if {$Category_wid > $wid} {
        set wid $Category_wid
    }
    set ew [entry  $p.sub.ent -width $wid -insertwidth 1 -insertofftime 400 \
            -relief sunken -borderwidth 2 -background grey95 -textvariable Submitter]
    lappend Tksendpr(tlist) $ew
    trace variable Submitter w set_snd_submitter_ew
    bind $ew <Enter> "+focus $ew"
    set height [llength $submitters_list]
    if {$height > 6 } {
        set height 6
    }
    scrollbar $p.sub.sb -command "$p.sub.list yview" -borderwidth 2 -relief sunken
    listbox $p.sub.list -yscroll "$p.sub.sb set" -setgrid 1 -relief sunken -borderwidth 2 \
            -width $wid -height $height -exportselection false
    eval   $p.sub.list insert end $submitters_list
    pack   $p.sub.msg  -side left  -anchor n
    pack   $p.sub.ent  -side left  -anchor n
    pack   $p.sub.sb   -side left  -fill y
    pack   $p.sub.list -side right -fill both -expand true
    bind   $p.sub.list <B1-ButtonRelease> "set_snd_submitter $p.sub.ent %W %y"
    return $p.sub.list
}

proc set_snd_category_ew {a b c} {
    upvar #0 $a f
    global CategoryList
    quickfill_entry_from_listbox f .eboxs.clb.cat.ent .eboxs.clb.cat.list $CategoryList
}
 
proc set_snd_submitter_ew {a b c} {
    upvar #0 $a f
    global SubmitterList
    quickfill_entry_from_listbox f .eboxs.slb.sub.ent .eboxs.slb.sub.list $SubmitterList
}

proc set_snd_category {ent w y} {
    global Category
    trace vdelete Category w set_snd_category_ew
    $ent delete 0 end
    set idx [$w nearest $y]
    set Category [$w get $idx]
    trace variable Category w set_snd_category_ew
}

proc set_snd_submitter {ent w y} {
    global Submitter
    trace vdelete Submitter w set_snd_submitter_ew
    $ent delete 0 end
    set idx [$w nearest $y]
    set Submitter [$w get $idx]
    trace variable Submitter w set_snd_submitter_ew
}

proc env_fld_text {} {
    set txt ""

    set code [catch {exec uname -a} result]
    if {$code == 0} {
	append txt "System: $result\n"
    }

    set code [catch {exec arch} result]
    if {$code == 0} {
	append txt "Architecture: $result\n"
    }

    set code [catch {exec xdpyinfo | fgrep endor} result]
    if {$code == 0} {
	append txt "X:\n----\n$result\n"
    }

    return $txt
}

frame .eflds
radiobar_frame .eflds .eflds.lb

radiobar     .eflds.lb class        Class        {sw-bug doc-bug change-request support} None
radiobar     .eflds.lb priority     Priority     {low medium high} None
radiobar     .eflds.lb severity     Severity     {non-critical serious critical} None
radiobar     .eflds.lb confidential Confidential {no yes} None
radiobar_set .eflds.lb class        $TkGnats(CreateDefaultClass)
radiobar_set .eflds.lb priority     $TkGnats(CreateDefaultPriority)
radiobar_set .eflds.lb severity     $TkGnats(CreateDefaultSeverity)
radiobar_set .eflds.lb confidential $TkGnats(CreateDefaultConfidential)
pack .eflds.lb -side left
pack .eflds    -side top  -fill x -anchor w

frame .eboxs
frame .eboxs.clb
snd_category_listbox  .eboxs.clb $CategoryList
frame .eboxs.slb
snd_submitter_listbox .eboxs.slb $SubmitterList
pack .eboxs.clb .eboxs.slb -side top -anchor w -pady 2
pack .eboxs -side top -fill x -anchor w -pady 2

set Submitter $TkGnats(Submitter-Id)

###     [singletext . Originator   80 "$TkGnats(EmailAddr) ([fullname_from_logname])" 14]
lappend Tksendpr(tlist) [singletext . Originator 80 "[fullname_from_logname]" 14]
lappend Tksendpr(tlist) [singletext . Reply-To   80 "$TkGnats(EmailAddr)" 14]
lappend Tksendpr(tlist) [singletext . Release    80 "" 14]
lappend Tksendpr(tlist) [singletext . Synopsis   80 "" 14]

if {$TkGnats(ReleaseBased)} {
    lappend Tksendpr(tlist) [singletext . Keywords 80 "" 14]
}

set Tksendpr(multitextflds) {
    >Description
    >How-To-Repeat
    >Environment
    >Fix
}

foreach tag $Tksendpr(multitextflds) {
    set frm($tag) ""
}

set frm(>Environment) [env_fld_text]
set current_multi_text ""

lappend Tksendpr(tlist) [make_txt_mb $Tksendpr(multitextflds)]
switch_txt  ">Description" $Tksendpr(multitextflds)

set_text_traversal $Tksendpr(tlist)

frame  .action -borderwidth 3
button .action.cancel      -borderwidth 2 -text "Cancel"        -command cancel_report
button .action.send        -borderwidth 2 -text "Send"          -command send_report
button .action.sendandexit -borderwidth 2 -text "Send and Exit" -command send_report_and_exit

pack .action.send .action.sendandexit .action.cancel -side left -padx 10

pack .action -side top

wm title      . "TkGnats - Create Problem Report"
wm iconbitmap . @$TkGnats(lib)/tksendpr.xbm
wm iconname   . "$TkGnats(LogName)'s tksendpr"
