# Copyright (c) 1993 by Sanjay Ghemawat
#############################################################################
# Bug Report dialog
#
# Commands
#
#	bug_notify <mailer> <email> <message>
#		Handle software error

# Hidden global variables
#
#	bug_init		Created bug window?
#	bug_done		Is bug interaction finished
#	bug_email		Email address where bug should be reported
#	bug_mailer		Mail program

set bug_init 0
set bug_done 0
set bug_email {}
set bug_mailer {}

proc bug_notify {mailer email message} {
    bug_make
    bug_interact $mailer $email $message
}

proc bug_make {} {
    global bug_init bug_done
    if {$bug_init} {return}
    set bug_init 1

    set f .bug_dialog
    toplevel $f -class Dialog
    wm title $f {Internal Error}
    wm protocol $f WM_DELETE_WINDOW {set bug_done 1}

    frame $f.top -relief raised -bd 1
    frame $f.mid -relief raised -bd 1
    frame $f.bot -relief raised -bd 1
    frame $f.bot.default -relief sunken -bd 1

    label $f.icon -bitmap [icon warn.xbm]
    message $f.warning -aspect 400 -text {Uninitialized message}

    scrollbar $f.scroll -relief raised -bd 1 -orient vertical\
	-command [list $f.text yview]
    text $f.text -width 40 -height 3 -wrap none -relief raised -bd 1\
	-yscroll [list $f.scroll set]

    button $f.ok -text Dismiss -command {set bug_done 1}
    button $f.mail -text {Mail Bug Report} -command {
	bug_mail
	set bug_done 1
    }

    pack append $f.top $f.icon {left padx 5m pady 5m}
    pack append $f.top $f.warning {right padx 5m pady 5m expand fill}

    pack append $f.mid $f.scroll {right filly}
    pack append $f.mid $f.text {bottom expand fill padx 5m pady 5m}

    pack append $f.bot.default $f.mail {left padx 3m pady 3m}
    pack append $f.bot $f.ok {left expand padx 5m pady 5m}
    pack append $f.bot $f.bot.default {left expand}

    pack append $f $f.top {top fill}
    pack append $f $f.mid {top expand fill}
    pack append $f $f.bot {bottom fill}

    bind $f <Control-c> {set bug_done 1}
    bind $f <Return> {
	bug_mail
	set bug_done 1
    }

    wm withdraw $f
    update
}

proc bug_interact {mailer email message} {
    global bug_done bug_email bug_mailer
    set f .bug_dialog

    # Configure text window height
    set height [llength [split $message "\n"]]
    if {$height > 20} {set height 20}

    # Configure notice
    $f.warning configure -text \
"An internal error has occurred in ical.  You can send a bug report to the author ($email) by clicking on the \"Mail Bug Report\" button at the bottom of this dialog.  The error trace displayed below will be the only information sent to the author.  If you do not want to send a bug report, click on the \"Dismiss\" button."

    $f.text configure -height $height
    $f.text delete 1.0 end
    $f.text insert 1.0 $message
    set bug_done -1
    set bug_email $email
    set bug_mailer $mailer
    dialog_run {} $f $f bug_done
}

proc bug_mail {} {
    catch {_bug_mail}
}

proc _bug_mail {} {
    global bug_email bug_mailer

    set f .bug_dialog
    set text [$f.text get 1.0 end]

    set mailproc [open [list | $bug_mailer $bug_email] w]
    catch {puts $mailproc {Subject: Bug report}}
    catch {puts $mailproc ========}
    catch {puts $mailproc $text}
    catch {puts $mailproc ========}
    close $mailproc
}
