~ubuntu-branches/ubuntu/warty/perl-tk/warty

« back to all changes in this revision

Viewing changes to Tixish/DialogBox.pm

  • Committer: Bazaar Package Importer
  • Author(s): Stephen Zander
  • Date: 2004-03-14 13:54:44 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040314135444-prc09u2or4dbr3to
Tags: 1:800.025-2
Add xlibs-dev to Build-Depends:,
Closes: #237942

Show diffs side-by-side

added added

removed removed

Lines of Context:
9
9
use Carp;
10
10
 
11
11
use vars qw($VERSION);
12
 
$VERSION = '3.032'; # $Id: //depot/Tk8/Tixish/DialogBox.pm#32 $
 
12
$VERSION = '3.035'; # $Id: //depot/Tk8/Tixish/DialogBox.pm#35 $
13
13
 
14
14
use base  qw(Tk::Toplevel);
15
15
 
27
27
    $cw->{'selected_button'} = '';
28
28
    $cw->transient($cw->Parent->toplevel);
29
29
    $cw->withdraw;
30
 
    $cw->protocol('WM_DELETE_WINDOW' => sub {});
 
30
    if (@$buttons == 1) {
 
31
        $cw->protocol('WM_DELETE_WINDOW' => sub { $cw->{'default_button'}->invoke });
 
32
    } else {
 
33
        $cw->protocol('WM_DELETE_WINDOW' => sub {});
 
34
    }
31
35
 
32
36
    # create the two frames
33
37
    my $top = $cw->Component('Frame', 'top');
42
46
    foreach $bl (@$buttons)
43
47
     {
44
48
        my $b = $bot->Button(-text => $bl, -command => sub { $cw->{'selected_button'} = "$bl" } );
 
49
        $b->bind('<Return>' => [ $b, 'Invoke']);
45
50
        $cw->Advertise("B_$bl" => $b);
46
51
        if ($Tk::platform eq 'MSWin32')
47
52
         {
56
61
                $b->pack(-in => $db, -padx => '2', -pady => '2');
57
62
                $db->pack(-side => 'left', -expand => 1, -padx => 1, -pady => 1);
58
63
            }
59
 
            $cw->bind('<Return>' => [ $b, 'Invoke']);
60
64
            $cw->{'default_button'} = $b;
61
65
        } else {
62
66
            $b->pack(-side => 'left', -expand => 1,  -padx => 1, -pady => 1);
86
90
}
87
91
 
88
92
sub Show {
89
 
    my ($cw, $grab) = @_;
 
93
 
90
94
    croak 'DialogBox: "Show" method requires at least 1 argument'
91
95
        if scalar @_ < 1;
 
96
    my $cw = shift;
 
97
    my ($grab) = @_;
92
98
    my $old_focus = $cw->focusSave;
93
99
    my $old_grab = $cw->grabSave;
94
100
 
95
 
    $cw->Popup();
 
101
    shift if defined $grab && length $grab && ($grab =~ /global/);
 
102
    $cw->Popup(@_);
96
103
 
97
104
    Tk::catch {
98
105
    if (defined $grab && length $grab && ($grab =~ /global/)) {