# DialogBox is similar to Dialog except that it allows any widget
# in the top frame. Widgets can be added with the add method. Currently
# there exists no way of deleting a widget once it has been added.
$VERSION = '3.032'; # $Id: //depot/Tk8/Tixish/DialogBox.pm#32 $
use base qw(Tk::Toplevel);
Tk
::Widget
->Construct('DialogBox');
$cw->SUPER::Populate
($args);
my $buttons = delete $args->{'-buttons'};
$buttons = ['OK'] unless defined $buttons;
my $default_button = delete $args->{'-default_button'};
$default_button = $buttons->[0] unless defined $default_button;
$cw->{'selected_button'} = '';
$cw->transient($cw->Parent->toplevel);
$cw->protocol('WM_DELETE_WINDOW' => sub {});
my $top = $cw->Component('Frame', 'top');
$top->configure(-relief
=> 'raised', -bd
=> 1) unless $Tk::platform
eq 'MSWin32';
my $bot = $cw->Component('Frame', 'bottom');
$bot->configure(-relief
=> 'raised', -bd
=> 1) unless $Tk::platform
eq 'MSWin32';
$bot->pack(qw
/-side bottom -fill both -ipady 3 -ipadx 3/);
$top->pack(qw
/-side top -fill both -ipady 3 -ipadx 3 -expand 1/);
# create a row of buttons in the bottom.
my $bl; # foreach my $var: perl > 5.003_08
my $b = $bot->Button(-text
=> $bl, -command
=> sub { $cw->{'selected_button'} = "$bl" } );
$cw->Advertise("B_$bl" => $b);
if ($Tk::platform
eq 'MSWin32')
$b->configure(-width
=> 10, -pady
=> 0);
if ($bl eq $default_button) {
if ($Tk::platform
eq 'MSWin32') {
$b->pack(-side
=> 'left', -expand
=> 1, -padx
=> 1, -pady
=> 1);
my $db = $bot->Frame(-relief
=> 'sunken', -bd
=> 1);
$b->pack(-in => $db, -padx
=> '2', -pady
=> '2');
$db->pack(-side
=> 'left', -expand
=> 1, -padx
=> 1, -pady
=> 1);
$cw->bind('<Return>' => [ $b, 'Invoke']);
$cw->{'default_button'} = $b;
$b->pack(-side
=> 'left', -expand
=> 1, -padx
=> 1, -pady
=> 1);
$cw->ConfigSpecs(-command
=> ['CALLBACK', undef, undef, undef ],
-foreground
=> ['DESCENDANTS', 'foreground','Foreground', 'black'],
-background
=> ['DESCENDANTS', 'background','Background', undef],
$cw->Delegates('Construct',$top);
my ($cw, $wnam, @args) = @_;
my $w = $cw->Subwidget('top')->$wnam(@args);
$cw->Advertise("\L$wnam" => $w);
$cw->waitVariable(\
$cw->{'selected_button'});
$cw->Callback(-command
=> $cw->{'selected_button'});
croak
'DialogBox: "Show" method requires at least 1 argument'
my $old_focus = $cw->focusSave;
my $old_grab = $cw->grabSave;
if (defined $grab && length $grab && ($grab =~ /global/)) {
if (defined $cw->{'default_button'}) {
$cw->{'default_button'}->focus;
return $cw->{'selected_button'};