package Tk::ErrorDialog;
use vars qw($VERSION);
$VERSION = '3.009'; # $Id: //depot/Tk8/Tk/ErrorDialog.pm#9 $
use English;
use Tk();
require Tk::Dialog;
use base qw(Tk::Toplevel);
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{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);
$cw->Advertise(text=>$t_text);
$cw->ConfigSpecs(-cleanupcode=>[PASSIVE=>undef,undef,undef],-appendtraceback=>[PASSIVE=>undef,undef,1]);
$ED_OBJECT=$cw;
return$cw;}sub Tk::Error{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;
$w->break if($ans=~/skip/i);}1;
