Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / demos / widget_lib / msgBox.pl

# msgBox.pl

use vars qw/$TOP/;

sub msgBox {
   my($demo) = @_;
   $TOP = $MW->WidgetDemo(
       -name             => $demo,
       -text             => 'Choose the icon and type option of the message box. Then press the "Message Box" button to see the message box.',
       -title            => 'messageBox Demo',
       -iconname         => 'messageBox',
   );

   my $upper = $TOP->Frame->pack;
   my $left = $upper->Frame;
   my $right = $upper->Frame;
   $left->pack(qw/-side left -expand yes -fill y  -pady .5c -padx .5c/);
   $right->pack(qw/-side left -expand yes -fill y  -pady .5c -padx .5c/);

   my $icon = $left->Label(qw/-text Icon/);
   my $lsep = $left->Frame(qw/-relief ridge -bd 1 -height 2/);
   $icon->pack(qw/-side top/);
   $lsep->pack(qw/-side top -fill x -expand no/);

   my $iconvar = 'info';
   foreach my $i (qw/error info question warning/) {
       $left->Radiobutton(-text => $i, -variable => \$iconvar, -value => $i,
                          qw/-width 16 -anchor w -relief flat/)->pack(
                          qw/-side top -pady 2 -anchor w -fill x/);
   }


   my $rl = $right->Label(qw/-text Type/);
   my $rsep = $right->Frame(qw/-relief ridge -bd 1 -height 2/);
   $rl->pack(qw/-side top/);
   $rsep->pack(qw/-side top -fill x -expand no/);

   my $typevar = 'OK';
   foreach my $t (qw/AbortRetryIgnore OK OKCancel RetryCancel YesNo YesNoCancel/) {
       $right->Radiobutton(-text => $t, -variable => \$typevar, -value => $t,
                           qw/-relief flat -width 16 -anchor w/)->pack(
                           qw/-side top -pady 2 -anchor w -fill x/);
   }

   my $show = $TOP->Button(-text => "Message Box", 
                           -command => [\&show_messageBox, \$iconvar, \$typevar]);
   $show->pack;
   
} # end msgBox

sub show_messageBox {
   my($iconvar, $typevar) = @_;

   my $button = $TOP->messageBox('-icon' => $$iconvar, -type => $$typevar,
       -title => 'Message',
       -message => "This is a \"$$typevar\" type messagebox with the \"$$iconvar\" icon");

   $TOP->messageBox(qw/-icon info -type OK -message/ => "You have selected \"$button\"");

} # end show_messageBox