Creating Dialog Boxes with Tk (Perl Cookbook, 2nd Edition)

## 15.15. Creating Dialog Boxes with Tk

### 15.15.1. Problem

You want to create a dialog box, i.e., a new top-level window with buttons to make the window go away. The dialog box might also have other items, such as labels and text entry widgets for creating a fill-out form. You could use such a dialog box to collect registration information, and you want it to go away when registration is sent or if the user chooses not to register.

### 15.15.2. Solution

For simple jobs, use the Tk::DialogBox widget:

>     use Tk::DialogBox;

>     $dialog = $main->DialogBox( -title   => "Register This Program",
>                                 -buttons => [ "Register", "Cancel" ] );

>     # add widgets to the dialog box with $dialog->Add( )

>     # later, when you need to display the dialog box
>     $button = $dialog->Show( );
>     if ($button eq "Register") {
>         # ...
>     } elsif ($button eq "Cancel") {
>         # ...
>     } else {
>         # this shouldn't happen
>     }

### 15.15.3. Discussion

A DialogBox has two parts: the bottom is a set of buttons, and the top has the widgets of your choosing. `Show` ing a DialogBox pops it up and returns the button the user selected.

Example 15-6 contains a complete program demonstrating the DialogBox.

#### Example 15-6. tksample3

>       #!/usr/bin/perl -w
>       # tksample3 - demonstrate dialog boxes

>       use Tk;
>       use Tk::DialogBox;

>       $main = MainWindow->new( );

>       $dialog = $main->DialogBox( -title   => "Register",
>                                   -buttons => [ "Register", "Cancel" ],
>                                  );

>       # the top part of the dialog box will let people enter their names,
>       # with a Label as a prompt

>       $dialog->add("Label", -text => "Name")->pack( );
>       $entry = $dialog->add("Entry", -width => 35)->pack( );

>       # we bring up the dialog box with a button
>       $main->Button( -text    => "Click Here For Registration Form",
>                      -command => \&register)    ->pack(-side => "left");
>       $main->Button( -text    => "Quit",
>                      -command => sub { exit } ) ->pack(-side => "left");

>       MainLoop;

>       #
>       # register
>       #
>       # Called to pop up the registration dialog box
>       #

>       sub register {
>           my $button;
>           my $done = 0;

>           do {
>               # show the dialog
>               $button = $dialog->Show;

>               # act based on what button they pushed
>               if ($button eq "Register") {
>                   my $name = $entry->get;

>                   if (defined($name) && length($name)) {
>                       print "Welcome to the fold, $name\n";
>                       $done = 1;
>                   } else {
>                       print "You didn't give me your name!\n";
>                   }
>               } else {
>                   print "Sorry you decided not to register.\n";
>                   $done = 1;
>               }
>           } until $done;
>       }

The top part of this DialogBox has two widgets: a label and a text entry. To collect more information from the user, we'd have more labels and text entries.

A common use of dialog boxes is to display error messages or warnings. The program in Example 15-7 demonstrates how to display Perl's `warn` function in a DialogBox.

#### Example 15-7. tksample4

>       #!/usr/bin/perl -w
>       # tksample4 - popup dialog boxes for warnings

>       use Tk;
>       use Tk::DialogBox;

>       my $main;

>       # set up a warning handler that displays the warning in a Tk dialog box

>       BEGIN {
>           $SIG{_ _WARN_ _} = sub {
>               if (defined $main) {
>                   my $dialog = $main->DialogBox( -title   => "Warning",
>                                                  -buttons => [ "Acknowledge" ]);
>                   $dialog->add("Label", -text => $_[0])->pack;
>                   $dialog->Show;
>               } else {
>                   print STDOUT join("\n", @_), "n";
>               }
>           };
>       }

>       # your program goes here

>       $main = MainWindow->new( );

>       $main->Button( -text   => "Make A Warning",
>                      -command => \&make_warning) ->pack(-side => "left");
>       $main->Button( -text   => "Quit",
>                      -command => sub { exit } )  ->pack(-side => "left");

>       MainLoop;

>       # dummy subroutine to generate a warning

>       sub make_warning {
>           my $a;
>           my $b = 2 * $a;
>       }

### 15.15.4. See Also

The Tk::DialogBox manpage in the documentation for the Tk module from CPAN; the menu(n) manpage (if you have it); Mastering Perl/Tk

Copyright © 2003 O'Reilly & Associates. All rights reserved.