Tk::ErrorDump - An alternative to Tk::Error or Tk::ErrorDialog

    use Tk::ErrorDump;

	my $errdlg = $mw->ErrorDump(
		-icon => $my_icon,
		-defaultfile => '*.tkd',
		-dumpcode => \&err_dlg_dump	# dump internal info
		-filtercode => \&filter_dump	# filter dump info
		[ the usual frame options ]
	);

    icon     - an app specific icon for the popup error dialog;
    	default is std. Tk icon

    defaultfile - the default filename (maybe wildcarded) used in the
    	getSaveFile dialog to create the dump file

    dumpcode - a CODE reference called after an error is intercepted
    	and the ErrorDump dialog is presented. It is passed a filehandle
    	to which the app can write any app-specific dump information

    filtercode - a CODE reference called before the ErrorDump dialog is 
    	presented. It is passed the error message and stack trace, and
    	returns them as an array. Intended to provide application
    	the opportunity to filter the error info before display.

package Tk::ErrorDump;

use vars qw($VERSION);
$VERSION = '0.02';

use English;
use Tk ();
use base qw(Tk::Toplevel);
use Tk::ROText;

use strict;

Construct Tk::Widget 'ErrorDump';

my $ED_OBJECT;

sub Populate {

    # ErrorDump constructor.  Uses `new' method from base class
    # to create object container then creates the dialog toplevel and the
    # traceback toplevel.

    my($cw, $args) = @_;

    $cw->minsize(1, 1);
    $cw->title('Dump Stack Trace for Error');
    $cw->iconname('Stack Trace');

	my $labframe = $cw->Frame->pack(-side => 'top', -fill => 'x', -expand => 1);
    my $t_bitmap = $labframe->Label(
        -bitmap         => 'error'
    )->grid(-column => 0, -row => 0, -sticky => 'e');

    my $t_label = $labframe->Label(
        -text           => 'on-the-fly-text',
        -justify => 'left', 
    )->grid(-column => 1, -row => 0, -sticky => 'w', -pady => 4);

    my $t_text = $cw->ROText(
        -relief  => 'sunken',
        -bd      => 2,
        -width   => 60,
        -height  => 20,
     )->pack(-side => 'top', -fill => 'both', -expand => 1);

    my $t_ok = $cw->Button(
        -text    => 'OK',
        -command => [
            sub {
            my $cw = shift;
# execute any cleanup code if it was defined
		   	my $c = $cw->{Configure}{'-dumpcode'};
		   	&$c(undef, @{$cw->{ErrorInfo}}) if defined $c;
			$cw->withdraw;
		    }, $cw,
        ]
    )->pack(-side => 'left', -anchor => 'center', -padx => '3m', -pady => '2m', -expand => 1);

    my $t_save = $cw->Button(
        -text    => 'Save Dump',
        -command => [
            sub {
				shift->Dump;
	    	}, $cw,
        ]
    )->pack(-side => 'left', -anchor => 'center', -padx => '3m', -pady => '2m', -expand => 1);

    $cw->withdraw;

    $cw->Advertise(error_label => $t_label); # advertise dialog widget
    $cw->Advertise(text => $t_text);     # advertise text widget
    $cw->ConfigSpecs(
    	-dumpcode => [PASSIVE => undef, undef, undef],
    	-filtercode => [PASSIVE => undef, undef, undef],
    	-icon => [ PASSIVE => undef, undef, undef ],
    	-defaultfile => [ PASSIVE => undef, undef, undef ]);
    $ED_OBJECT = $cw;
    return $cw;

} # end new, ErrorDialog constructor
#
#	request a Save file, then dump our
#	traceback, then let app dump whatever it needs to
#
sub Dump {
	my ($cw) = @_;
#
#	open saveas dialog
#
	my $dumpfile = $cw->getSaveFile(
		-title => 'Save Project As',
		-initialfile => $ED_OBJECT->{Configure}{'-defaultfile'});
	my $fh;

	print $fh "--- ERROR ---\n",
		(shift @{$cw->{ErrorInfo}}), "\n",
		"---- Begin Traceback ----\n",
		join("\n", @{$cw->{ErrorInfo}}), "\n"
		if ($dumpfile && open($fh, ">>$dumpfile"));

# execute any cleanup code if it was defined
   	my $c = $cw->{Configure}{'-dumpcode'};
   	&$c($fh, @{$cw->{ErrorInfo}}) 
   		if (defined($c) && (ref $c) && (ref $c eq 'CODE'));
   	close $fh;
   	$cw->withdraw;
}

sub Tk::Error {

    # Post a dialog box with the error message and give the user a chance
    # to see a more detailed stack trace.

    my($w, $error, @msgs) = @_;

    my $grab = $w->grab('current');
    $grab->Unbusy if (defined $grab);
#
#	create widget if not exists
#
    $w->ErrorDump if not defined $ED_OBJECT;
	my $cw = $ED_OBJECT;
#
#	apply filter if defined
#
   	my $c = $cw->{Configure}{'-filtercode'};
   	($error, @msgs) = &$c($error, @msgs)
   		if (defined($c) && (ref $c) && (ref $c eq 'CODE'));

	$cw->{ErrorInfo} = [ ($error, @msgs) ];
	my $lbl = $cw->Subwidget('error_label');
	$lbl->configure(-text => $error);
    my $t = $cw->Subwidget('text');
    my $icon = $cw->{Configure}{-icon};
	$cw->Icon(-image => $icon) if $icon;
    $t->bell;
	$t->configure(-background => 'white');

    chop $error;
    $t->delete('0.0', 'end');
    $t->insert('end', "\n");
    $t->mark('set', 'ltb', 'end');
    $t->insert('end', "--- Begin Traceback ---\n$error\n");
    my $msg;
    for $msg (@msgs) {
		$t->insert('end', "$msg\n");
    }
    $t->yview('ltb');
    $cw->deiconify;
    $cw->raise();

#    $w->break if ($ans =~ /skip/i);

} # end Tk::Error


1;


__END__


=cut