path: root/library/bgerror.tcl

# bgerror.tcl --
#
#	Implementation of the bgerror procedure.  It posts a dialog box with
#	the error message and gives the user a chance to see a more detailed
#	stack trace, and possible do something more interesting with that
#	trace (like save it to a log).  This is adapted from work done by
#	Donal K. Fellows.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
# 
# RCS: @(#) $Id: bgerror.tcl,v 1.9 2000/05/31 23:28:46 ericm Exp $
# $Id: bgerror.tcl,v 1.9 2000/05/31 23:28:46 ericm Exp $

option add *ErrorDialog.message.wrapLength 3.5i widgetDefault
option add *ErrorDialog.function.text "Save To Log" widgetDefault
option add *ErrorDialog.function.command "::tk::dialog::error::saveToLog"

namespace eval ::tk {}
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::error {}

proc ::tk::dialog::error::Return {} {
    variable button
    
    .bgerrorDialog.ok configure -state active -relief sunken
    update idletasks
    after 100
    set button 0
}

proc ::tk::dialog::error::details {} {
    set w .bgerrorDialog
    set caption [option get $w.function text {}]
    set command [option get $w.function command {}]
    if { [string equal $caption ""] || [string equal $command ""] } {
	grid forget $w.function
    }
    $w.function configure -text $caption \
	    -command [list ::tk::dialog::error::evalFunction $command]
    grid $w.top.info - -sticky nsew -padx 3m -pady 3m
}

proc ::tk::dialog::error::evalFunction {cmd} {
    uplevel \#0 [list $cmd [.bgerrorDialog.top.info.text get 1.0 end]]
}

proc ::tk::dialog::error::saveToLog {text} {
    if { [string equal $::tcl_platform(platform) "windows"] } {
	set allFiles "*.*"
    } else {
	set allFiles "*"
    }
    set types [list	\
	    [list "Log Files"	.log]		\
	    [list "Text Files"	.txt]		\
	    [list "All Files"	$allFiles]	\
	    ]
    set filename [tk_getSaveFile -title "Select Log File" \
	    -filetypes $types -defaultextension .log -parent .bgerrorDialog]
    if {![string length $filename]} {
	return
    }
    set f [open $filename w]
    puts -nonewline $text
    close $f
}

proc ::tk::dialog::error::Destroy {w} {
    if {".bgerrorDialog" == "$w"} {
	variable button
	set button -1
    }
}

# bgerror --
# This is the default version of bgerror. 
# It tries to execute tkerror, if that fails it posts a dialog box containing
# the error message and gives the user a chance to ask to see a stack
# trace.
# Arguments:
# err -			The error message.

proc bgerror err {
    global errorInfo tcl_platform
    set butvar ::tk::dialog::error::button

    set info $errorInfo

    set ret [catch {tkerror $err} msg];
    if {$ret != 1} {return -code $ret $msg}

    # Ok the application's tkerror either failed or was not found
    # we use the default dialog then :
    if {$tcl_platform(platform) == "macintosh"} {
	set ok		"Ok"
	set messageFont	system
	set textRelief	"flat"
	set textHilight	0
    } else {
	set ok		"OK"
	set messageFont	{Times -18}
	set textRelief	"sunken"
	set textHilight	1
    }

    set w .bgerrorDialog
    set title "Application Error"
    set text "Error: $err"
    set buttons [list ok $ok dismiss "Skip Messages" function "Details >>"]

    # 1. Create the top-level window and divide it into top
    # and bottom parts.

    catch {destroy .bgerrorDialog}
    toplevel .bgerrorDialog -class ErrorDialog
    wm title .bgerrorDialog $title
    wm iconname .bgerrorDialog ErrorDialog
    wm protocol .bgerrorDialog WM_DELETE_WINDOW { }

    # The following, though surprising, works.
    wm transient .bgerrorDialog .bgerrorDialog

    if {$tcl_platform(platform) == "macintosh"} {
	unsupported1 style .bgerrorDialog dBoxProc
    }

    frame .bgerrorDialog.bot
    frame .bgerrorDialog.top
    if {$tcl_platform(platform) == "unix"} {
	.bgerrorDialog.bot configure -relief raised -bd 1
	.bgerrorDialog.top configure -relief raised -bd 1
    }
    pack .bgerrorDialog.bot -side bottom -fill both
    pack .bgerrorDialog.top -side top -fill both -expand 1

    set W [frame $w.top.info]
    text $W.text				\
	    -bd 2				\
	    -yscrollcommand "$W.scroll set"	\
	    -setgrid true			\
	    -width 40				\
	    -height 10				\
	    -state normal			\
	    -relief $textRelief			\
	    -highlightthickness $textHilight	\
	    -wrap char

    scrollbar $W.scroll -relief sunken -command "$W.text yview"
    pack $W.scroll -side right -fill y
    pack $W.text -side left -expand yes -fill both
    $W.text insert 0.0 $info
    $W.text mark set insert 0.0
    $W.text configure -state disabled

    # 2. Fill the top part with bitmap and message (use the option
    # database for -wraplength so that it can be overridden by
    # the caller).

    label .bgerrorDialog.msg -justify left -text $text -font $messageFont
    if { [string equal $tcl_platform(platform) "macintosh"] } {
	# On the Macintosh, use the stop bitmap
	label .bgerrorDialog.bitmap -bitmap stop
    } else {
	# On other platforms, make the error icon
	canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0
	.bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
	.bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4
	.bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4
    }
    grid .bgerrorDialog.bitmap .bgerrorDialog.msg \
	    -in .bgerrorDialog.top	\
	    -row 0			\
	    -padx 3m			\
	    -pady 3m
    grid configure		.bgerrorDialog.msg -sticky nsw
    grid rowconfigure		.bgerrorDialog.top 1 -weight 1
    grid columnconfigure	.bgerrorDialog.top 1 -weight 1

    # 3. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach {name caption} $buttons {
	button .bgerrorDialog.$name	\
		-text $caption		\
		-default normal		\
		-command "set $butvar $i"
	grid .bgerrorDialog.$name	\
		-in .bgerrorDialog.bot	\
		-column $i		\
		-row 0			\
		-sticky ew		\
		-padx 10
	grid columnconfigure .bgerrorDialog.bot $i -weight 1
	# We boost the size of some Mac buttons for l&f
	if {$tcl_platform(platform) == "macintosh"} {
	    if {($name == "ok") || ($name == "dismiss")} {
		grid columnconfigure .bgerrorDialog.bot $i -minsize 79
	    }
	}
	incr i
    }
    # The "OK" button is the default for this dialog.
    .bgerrorDialog.ok configure -default active

    set ::tk::dialog::error::curh 0
    bind .bgerrorDialog <Return>	{::tk::dialog::error::Return}
    bind .bgerrorDialog <Destroy>	{::tk::dialog::error::Destroy %W}
    .bgerrorDialog.function configure	\
	    -command {::tk::dialog::error::details   }

    # 6. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw .bgerrorDialog
    update idletasks
    set parent [winfo parent	.bgerrorDialog]
    set width  [winfo reqwidth	.bgerrorDialog]
    set height [winfo reqheight	.bgerrorDialog]
    set x [expr ([winfo screenwidth .bgerrorDialog]  - $width )/2 - \
	    [winfo vrootx $parent]]
    set y [expr ([winfo screenheight .bgerrorDialog] - $height)/2 - \
	    [winfo vrooty $parent]]
    .bgerrorDialog configure -width $width
    wm geometry .bgerrorDialog +$x+$y
    wm deiconify .bgerrorDialog

    # 7. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current .bgerrorDialog]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab .bgerrorDialog
    focus .bgerrorDialog.ok

    # 8. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable $butvar
    set button $::tk::dialog::error::button; # Save a copy...
    catch {focus $oldFocus}
    catch {destroy .bgerrorDialog}
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }

    if {$button == 1} {
	return -code break
    }
}