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
=head1 NAME
Tk::ErrorDump - An alternative to Tk::Error or Tk::ErrorDialog
=head1 SYNOPSIS
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.
=head1 DESCRIPTION
[ NOTE: This module is derived directly from Tk::ErrorDialog...
tho you probably can't tell it anymore ]
An error dialog that traps Tk errors, then displays the error and
stack trace in a ROText widget, and gives the user the opportunity
to save that information in a file. In addition, the application
can provide a callback which is invoked after the dialog is
presented, and to which the dumpfile handle (if any) is passed,
in order for the application to dump any internal diagnostic
information, and/or execute cleanup code.
=head1 PREREQUISITES
Tk::ROText
Tk::getSaveFile
=head1 CAVEATS
None so far...
=head1 AUTHORS
Dean Arnold, darnold@presicient.com
Original Tk::ErrorDialog by Stephen O. Lidie,
Lehigh University Computing Center. lusol@Lehigh.EDU
=head1 HISTORY
December 29, 2003 : Converted from Tk::ErrorDialog
=cut