summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/ErrorDialog.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/ErrorDialog.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/ErrorDialog.pm125
1 files changed, 0 insertions, 125 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/ErrorDialog.pm b/Master/tlpkg/tlperl/lib/Tk/ErrorDialog.pm
deleted file mode 100644
index 19377eaeca4..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/ErrorDialog.pm
+++ /dev/null
@@ -1,125 +0,0 @@
-package Tk::ErrorDialog;
-
-use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #7 $ =~ /\D(\d+)\s*$/;
-
-use Tk ();
-require Tk::Dialog;
-use base qw(Tk::Toplevel);
-
-
-# ErrorDialog - a translation of bgerror() from Tcl/Tk to Perl/Tk.
-#
-# Currently TkPerl background errors are sent to stdout/stderr; use this
-# module if you want them in a window. You can also "roll your own" by
-# supplying the routine Tk::Error.
-
-use strict;
-
-Construct Tk::Widget 'ErrorDialog';
-
-my %options = ( -buttons => ['OK', 'Skip Messages', 'Stack trace'],
- -bitmap => 'error'
- );
-my $ED_OBJECT;
-
-sub import
-{
- my $class = shift;
- while (@_)
- {
- my $key = shift;
- my $val = shift;
- $options{$key} = $val;
- }
-}
-
-sub Populate {
-
- # ErrorDialog constructor. Uses `new' method from base class
- # to create object container then creates the dialog toplevel and the
- # traceback toplevel.
-
- my($cw, $args) = @_;
-
- my $dr = $cw->Dialog(
- -title => 'Error in '.$cw->MainWindow->name,
- -text => 'on-the-fly-text',
- -bitmap => $options{'-bitmap'},
- -buttons => $options{'-buttons'},
- );
- $cw->minsize(1, 1);
- $cw->title('Stack Trace for Error');
- $cw->iconname('Stack Trace');
- my $t_ok = $cw->Button(
- -text => 'OK',
- -command => [
- sub {
- shift->withdraw;
- }, $cw,
- ]
- );
- my $t_text = $cw->Text(
- -relief => 'sunken',
- -bd => 2,
- -setgrid => 'true',
- -width => 60,
- -height => 20,
- );
- my $t_scroll = $cw->Scrollbar(
- -relief => 'sunken',
- -command => ['yview', $t_text],
- );
- $t_text->configure(-yscrollcommand => ['set', $t_scroll]);
- $t_ok->pack(-side => 'bottom', -padx => '3m', -pady => '2m');
- $t_scroll->pack(-side => 'right', -fill => 'y');
- $t_text->pack(-side => 'left', -expand => 'yes', -fill => 'both');
- $cw->withdraw;
-
- $cw->Advertise(error_dialog => $dr); # advertise dialog widget
- $cw->Advertise(text => $t_text); # advertise text widget
- $cw->ConfigSpecs(-cleanupcode => [PASSIVE => undef, undef, undef],
- -appendtraceback => [ PASSIVE => undef, undef, 1 ]);
- $ED_OBJECT = $cw;
- $cw->protocol('WM_DELETE_WINDOW' => sub {$cw->withdraw});
- return $cw;
-
-} # end Populate
-
-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);
-
- $w->ErrorDialog if not defined $ED_OBJECT;
-
- my($d, $t) = ($ED_OBJECT->Subwidget('error_dialog'), $ED_OBJECT->Subwidget('text'));
-# chop $error;
- $d->configure(-text => "Error: $error");
- $d->bell;
- my $ans = $d->Show;
-
- $t->delete('0.0', 'end') if not $ED_OBJECT->{'-appendtraceback'};
- $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');
-
- $ED_OBJECT->deiconify if ($ans =~ /trace/i);
-
- my $c = $ED_OBJECT->{Configure}{'-cleanupcode'};
- &$c if defined $c; # execute any cleanup code if it was defined
- $w->break if ($ans =~ /skip/i);
-
-} # end Tk::Error
-
-1;