home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Dialog.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  6.6 KB  |  208 lines
  1. # Dialog - a translation of `tk_dialog' from Tcl/Tk to TkPerl (based on
  2. # John Stoffel's idea).
  3. #
  4. # Stephen O. Lidie, Lehigh University Computing Center.  94/12/27
  5. # lusol@Lehigh.EDU
  6. #
  7. # This is an OO implementation of `tk_dialog'.  First, create all your Dialog
  8. # objects during program initialization.  When it's time to use a dialog, 
  9. # invoke the `show' method on a dialog object; the method then displays the 
  10. # dialog, waits for a button to be invoked, and returns the text label of the 
  11. # selected button.
  12. #
  13. # A Dialog object essentially consists of two subwidgets: a Label widget for
  14. # the bitmap and a Label wigdet for the text of the dialog.  If required, you 
  15. # can invoke the `configure' method to change any characteristic of these 
  16. # subwidgets.
  17. #
  18. # Because a Dialog object is a Toplevel widget all the 'composite' base class
  19. # methods are available to you.
  20. #
  21. # Advertised widgets:  bitmap, message.
  22. #
  23. # 1) Call the constructor to create the dialog object, which in turn returns 
  24. #    a blessed reference to the new composite widget:
  25. #
  26. #    require Tk::Dialog;
  27. #
  28. #    $DialogRef = $mw->Dialog(
  29. #        -title          => $title,
  30. #        -text           => $text,
  31. #        -bitmap         => $bitmap,
  32. #        -default_button => $default_button,
  33. #        -buttons        => [@button_labels],
  34. #    );
  35. #
  36. #       mw             - a window reference, usually the result of a
  37. #                        MainWindow->new call.
  38. #       title          - Title to display in the dialog's decorative frame.
  39. #       text           - Message to display in the dialog widget.
  40. #       bitmap         - Bitmap to display in the dialog.
  41. #       default_button - Text label of the button that is to display the
  42. #                        default ring (''signifies no default button).
  43. #       button_labels  - A reference to a list of one or more strings to
  44. #                        display in buttons across the bottom of the dialog.
  45. #
  46. # 2) Invoke the `show' method on a dialog object:
  47. #
  48. #    $button_label = $DialogRef->Show;
  49. #
  50. #       This returns the text label of the selected button.
  51. #
  52. #    (Note:  you can request a global grab by passing the string "-global"
  53. #    to the `show' method.)
  54.  
  55. package Tk::Dialog;
  56. use Carp;
  57. use strict qw(vars);
  58. require Tk::Toplevel;
  59. @Tk::Dialog::ISA = qw(Tk::Toplevel);
  60.  
  61. Construct Tk::Widget 'Dialog';
  62.  
  63.  
  64. sub Populate
  65. {
  66.  
  67.     # Dialog object constructor.  Uses `new' method from base class
  68.     # to create object container then creates the dialog toplevel.
  69.  
  70.     my($cw, $args) = @_;
  71.  
  72.     $cw->SUPER::Populate($args);
  73.  
  74.     my ($w_bitmap,$w_but,$pad1,$pad2);
  75.  
  76.     my $buttons = delete $args->{'-buttons'};
  77.     $buttons = ['OK'] unless (defined $buttons);
  78.     my $default_button = delete $args->{-default_button};
  79.     $default_button =  $buttons->[0] unless (defined $default_button);
  80.  
  81.     
  82.     # Create the Toplevel window and divide it into top and bottom parts.
  83.  
  84.     $cw->{'selected_button'} = '';
  85.     my (@pl) = (-side => 'top', -fill => 'both');
  86.     ($pad1, $pad2) =
  87.         ([-padx => '3m', -pady => '3m'], [-padx => '3m', -pady => '2m']);
  88.  
  89.     $cw->withdraw;
  90.     $cw->iconname('Dialog');
  91.     $cw->protocol('WM_DELETE_WINDOW' => sub {});
  92.     $cw->transient($cw->Parent->toplevel);
  93.  
  94.     my $w_top = $cw->Frame(Name => 'top',-relief => 'raised', -borderwidth => 1);
  95.     my $w_bot = $cw->Frame(Name => 'bot',-relief => 'raised', -borderwidth => 1);
  96.     $w_top->pack(@pl);
  97.     $w_bot->pack(@pl);
  98.  
  99.     # Fill the top part with the bitmap and message.
  100.  
  101.     @pl = (-side => 'left');
  102.  
  103.     $w_bitmap = $w_top->Label(Name => 'bitmap');
  104.     $w_bitmap->pack(@pl, @$pad1);
  105.  
  106.     my $w_msg = $w_top->Label( -wraplength => '3i', -justify    => 'left' );
  107.  
  108.     $w_msg->pack(-side => 'right', -expand => 1, -fill => 'both', @$pad1);
  109.  
  110.     # Create a row of buttons at the bottom of the dialog.
  111.  
  112.     my($w_default_button, $bl) = (undef, '');
  113.     foreach $bl (@$buttons) {
  114.         $w_but = $w_bot->Button(
  115.             -text => $bl,
  116.             -command => [
  117.                 sub {
  118.                     $_[0]->{'selected_button'} = $_[1];
  119.                 }, $cw, $bl,
  120.             ]
  121.         );
  122.         if ($bl eq $default_button) {
  123.             $w_default_button = $w_bot->Frame(
  124.                 -relief      => 'sunken',
  125.                 -borderwidth => 1
  126.             );
  127.             $w_but->raise($w_default_button);
  128.             $w_default_button->pack(@pl, -expand => 1, @$pad2);
  129.             $w_but->pack(-in => $w_default_button, -padx => '2m',
  130.                          -pady => '2m');
  131.             $cw->bind(
  132.                 '<Return>' => [
  133.                     sub {
  134.                         $_[1]->flash; 
  135.                         $_[2]->{'selected_button'} = $_[3];
  136.                     }, $w_but, $cw, $bl,
  137.                 ]
  138.             );
  139.         } else {
  140.          $w_but->pack(@pl, -expand => 1, @$pad2);
  141.         }
  142.     } # forend all buttons
  143.  
  144.     $cw->Advertise(message => $w_msg);
  145.     $cw->Advertise(bitmap  => $w_bitmap );
  146.     $cw->{'default_button'} = $w_default_button;
  147.  
  148.     $cw->ConfigSpecs(
  149.                       -image      => ['bitmap',undef,undef,undef],
  150.                       -bitmap     => ['bitmap',undef,undef,undef],
  151.                       -fg         => ['ADVERTISED','foreground','Foreground','black'],
  152.                       -foreground => ['ADVERTISED','foreground','Foreground','black'],
  153.                       -bg         => ['DESCENDANTS','background','Background',undef],
  154.                       -background => ['DESCENDANTS','background','Background',undef],
  155.                       -font       => ['message','font','Font', '-*-Times-Medium-R-Normal--*-180-*-*-*-*-*-*'],
  156.                       DEFAULT     => ['message',undef,undef,undef]
  157.                      );
  158. } # end Dialog constructor
  159.  
  160. sub Show {
  161.  
  162.     # Dialog object public method - display the dialog.
  163.  
  164.     my ($cw, $grab_type) = @_;
  165.  
  166.     croak "Dialog:  `show' method requires at least 1 argument"
  167.         if scalar @_ < 1 ;
  168.  
  169.     my $old_focus = $cw->focusSave;
  170.     my $old_grab  = $cw->grabSave;
  171.  
  172.     # Update all geometry information, center the dialog in the display
  173.     # and deiconify it
  174.  
  175.     $cw->Popup(); 
  176.  
  177.     # set a grab and claim the focus.
  178.  
  179.     if (defined $grab_type && length $grab_type) {
  180.         $cw->grab($grab_type);
  181.     } else {
  182.         $cw->grab;
  183.     }
  184.     $cw->waitVisibility;
  185.     $cw->update;
  186.     if (defined $cw->{'default_button'}) 
  187.      {
  188.       $cw->{'default_button'}->focus;
  189.      } 
  190.     else 
  191.      {
  192.       $cw->focus;
  193.      }
  194.  
  195.     # Wait for the user to respond, restore the focus and grab, withdraw
  196.     # the dialog and return the label of the selected button.
  197.  
  198.     $cw->waitVariable(\$cw->{'selected_button'});
  199.     $cw->grabRelease;
  200.     $cw->withdraw;
  201.     &$old_focus;
  202.     &$old_grab;
  203.     return $cw->{'selected_button'};
  204.  
  205. } # end Dialog show method
  206.  
  207. 1;
  208.