Recipe 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. Showing 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