sub MessageBox { my ($kind,%args) = @_; require Tk::Dialog; my $parent = delete $args{'-parent'}; my $args = \%args; $args->{-bitmap} = delete $args->{-icon} if defined $args->{-icon}; $args->{-text} = delete $args->{-message} if defined $args->{-message}; $args->{-type} = 'OK' unless defined $args->{-type}; my $type; if (defined($type = delete $args->{-type})) { delete $args->{-type}; my @buttons = grep($_,map(ucfirst($_), split(/(abort|retry|ignore|yes|no|cancel|ok)/, lc($type)))); $args->{-buttons} = [@buttons]; $args->{-default_button} = ucfirst(delete $args->{-default}) if defined $args->{-default}; if (not defined $args->{-default_button} and scalar(@buttons) == 1) { $args->{-default_button} = $buttons[0]; } my $md = $parent->Dialog(%$args); my $an = $md->Show; $md->destroy if Tk::Exists($md); return $an; } } # end messageBox