#
# Copyright (c) 1993 Eric Schenk.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL ERIC SCHENK BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF ERIC
# SCHENK HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# ERIC SCHENK SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND ERIC SCHENK HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# tkerror for stkwm.
#
# Loosly based upon tkerror for exmh.
# Portions of this code Copyright (c) 1993 Xerox Coporation, original
# copyright message below.
#
# Copyright (c) 1993 Xerox Corporation.
# Use and copying of this software and preparation of derivative works based
# upon this software are permitted. Any distribution of this software or
# derivative works must comply with all applicable United States export
# control laws. This software is made available AS IS, and Xerox Corporation
# makes no warranty about the software, its performance or its conformity to
# any specification.

#
# tkerror --
#	This is the handler for background errors that arise
#	from commands bound to keystrokes and menus.  A
#	toplevel message widget is used to display $errorInfo

proc tkerror { msg } {
    global errorInfo
    global tkwm

    set font fixed
    set base ".errorInfo"
    set title "Tkwm Internal Error Info"
    if [info exists errorInfo] {
	set savedErrorInfo $errorInfo
    } else {
	set savedErrorInfo {no errorInfo}
    }
    set savedErrorInfo "Error Message:\n$msg\nTCL Stack Trace:\n$errorInfo"

    # Create a toplevel to contain the error trace back
    if [catch {
	# Choose a unique name by testing for the associated error variable
	# Use the string ".errorInfo-N" as the name of the toplevel
	# and as the name of a variable holding the current errorInfo
	for {set x 1} {"1"} {set x [expr $x+1]} {
	    if {! [winfo exists $base-$x]} {
		break
	    }
	}
	set title $title-$x
	set name $base-$x

	set wx [expr ($x%20)*10]
    	set inside [create_iwindow $name tkwmError TkwmError]
        wm iconname $name "Stack Trace"
        wm minsize $name 1 1
        wm iconbitmap $name error

	wm title $name $title
        $name.decoration config -title [wm title $name]
    
	frame $inside.buttons
	pack $inside.buttons -side top -fill x -expand 0

	button $inside.buttons.quit -text "Dismiss" -command [list destroy $name]
	pack $inside.buttons.quit -side left
	if [info exists tkwm(maintainer)] {
	    button $inside.buttons.mailto -text "Mail to $tkwm(maintainer)" -command [list TkwmMailError $name $inside $savedErrorInfo]
	    pack $inside.buttons.mailto -side right
	}

	text $inside.user -font $font -width 80 -bd 2 -relief raised
	$inside.user configure -height 3
	$inside.user insert end "User notes (PLEASE tell me something about\n"
	$inside.user insert end "what you where doing when this error happened): "
	pack $inside.user -side top -expand 1 -fill both

	text $inside.msg -font $font -width 80 -bd 2 -relief raised
	set numLines [llength [split $savedErrorInfo \n]]
	if {$numLines > 20} {
	    set numLines 20
	}
	$inside.msg configure -height $numLines
	$inside.msg insert end $savedErrorInfo
	pack $inside.msg -side top -expand 1 -fill both
        update idletasks
        set x [expr [winfo screenwidth $name]/2 - [winfo reqwidth $name]/2 \
	        - [winfo vrootx [winfo parent $name]]]
        set y [expr [winfo screenheight $name]/2 - [winfo reqheight $name]/2 \
	        - [winfo vrooty [winfo parent $name]]]
        wm geom $name +$x+$y
        imap_request $name 0
    } oops] {
	set msg [concat $msg "($name: " $oops ")" ]
	puts stderr $savedErrorInfo
    }
}

proc TkwmMailError { w inside errInfo } {
    global tkwm
    if [catch {open /tmp/tkwmErrorMsg w} out] {
	puts "Cannot open /tmp/tkwmErrorMsg"
	return
    }
    if [catch {
	global env
	puts $out "Date [exec date]"
	if [info exists env(USER)] {
	    puts $out "User $env(USER) got an error"
	}
	puts $out "Tkwm version $tkwm(version)"
	puts $out ""
	puts $out [$inside.user get 1.0 end]
	puts $out ""
	puts $out $errInfo
	close $out
    } msg] {
	puts "Write failed on /tmp/tkwmErrorMsg"
	return
    }
    if [catch {
	exec mail -s "tkwm error" $tkwm(maintainer) </tmp/tkwmErrorMsg
	exec rm /tmp/tkwmErrorMsg
    } msg] {
	return
    } else {
	destroy $w
    }
}