Recipe 15.15. Creating Dialog Boxes with Tk
Author: Tom Christiansen & Nathan Torkington
Date: 1999-07-02T01:43:30Z

#

| Chapter 15 User Interfaces |

## 15.15. Creating Dialog Boxes with Tk

### 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.

### 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
    }

### 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;
    }

### See Also

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

15.14. Creating Menus with Tk |  | 15.16. Responding to Tk Resize Events