# # -*-Perl-*- 
# 
# $Id: MessageBox.pm,v 1.7 1997/04/24 10:24:56 dn1 Exp $
#
# $Log: MessageBox.pm,v $
# Revision 1.7  1997/04/24  10:24:56  dn1
# Added copyright
#
# Revision 1.6  1996/10/11  09:11:43  dmh
# Added &infoDialogue for handyness.
#
# Revision 1.5  1996/10/10  10:39:45  dmh
# Added convenient errorDialogue method.
#
# Revision 1.4  1996/08/05  14:01:22  dmh
# Added $this->SUPER::Populate($args);
#
# Revision 1.3  1996/08/05  13:58:17  dmh
# Disposed of InheritThis()
#
# Revision 1.2  1996/07/19  11:19:23  dmh
# Changed Tk-b08  --> Tk-b11 incompatibility problem of
# currentfocus to focusCurrent.
#
# Revision 1.1  1996/05/13  13:23:17  dmh
# Initial revision
#
#
#
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

package Tk::MessageBox;
use strict qw(vars);
require Tk::Toplevel;
@Tk::MessageBox::ISA = qw(Tk::Toplevel);

Tk::Widget->Construct('MessageBox');


sub Populate {

    # Dialog object constructor.  Uses `new' method from base class
    # to create object container then creates the dialog toplevel.

    my($cw, $args) = @_;

    $cw->SUPER::Populate($args);

    my ($w_bitmap,$w_but,$pad1,$pad2);

    my $buttons = delete $args->{'-buttons'};
    $buttons = ['OK'] unless (defined $buttons);
    my $default_button = delete $args->{-default_button};
    $default_button =  $buttons->[0] unless (defined $default_button);

    
    # Create the Toplevel window and divide it into top and bottom parts.

    $cw->{'selected_button'} = '';
    my (@pl) = (-side => 'top', -fill => 'both');
    ($pad1, $pad2) =
        ([-padx => '3m', -pady => '3m'], [-padx => '3m', -pady => '2m']);

#    $cw->withdraw;
    $cw->iconname('Dialog');
    $cw->protocol('WM_DELETE_WINDOW' => sub {});
#    $cw->transient($cw->toplevel);

    my $w_top = $cw->Frame(Name => 'top',-relief => 'raised', -borderwidth => 1);
    my $w_bot = $cw->Frame(Name => 'bot',-relief => 'raised', -borderwidth => 1);
    $w_top->pack(@pl);
    $w_bot->pack(@pl);

    # Fill the top part with the bitmap and message.

    @pl = (-side => 'left');

    $w_bitmap = $w_top->Label(Name => 'bitmap');
    $w_bitmap->pack(@pl, @$pad1);

    my $w_msg = $w_top->Label( -wraplength => '3i', -justify    => 'left' );
    $w_msg->pack(-side => 'right', -expand => 1, -fill => 'both', @$pad1);

    # Create a row of buttons at the bottom of the dialog.

    my($w_default_button, $bl) = (undef, '');
    foreach $bl (@$buttons) {
        $w_but = $w_bot->Button(
				-text => $bl,
				-command => [ sub {
				    $_[0]->{'selected_button'} = $_[1];
				}, $cw, $bl,]
				);

        if ($bl eq $default_button) {
            $w_default_button = $w_bot->Frame(
					      -relief      => 'sunken',
					      -borderwidth => 1
					      );
            $w_but->raise($w_default_button);
            $w_default_button->pack(@pl, -expand => 1, @$pad2);
            $w_but->pack(-in => $w_default_button, -padx => '2m',-pady => '2m');
                         
            $cw->bind(
		      '<Return>' => [sub {
			  $_[1]->flash; 
			  $_[2]->{'selected_button'} = $_[3];
		      }, $w_but, $cw, $bl,]
		      );
        } else {
	    $w_but->pack(@pl, -expand => 1, @$pad2);
        }
    }


    $cw->Advertise(message => $w_msg);
    $cw->Advertise(bitmap  => $w_bitmap );
    $cw->{'default_button'} = $w_default_button;

    $cw->ConfigSpecs(
                      -bitmap     => ['bitmap',undef,undef,undef],
                      -fg         => ['ADVERTISED','foreground','Foreground','black'],
                      -foreground => ['ADVERTISED','foreground','Foreground','black'],
                      -bg         => ['DESCENDANTS','background','Background',undef],
                      -background => ['DESCENDANTS','background','Background',undef],
                      -font       => ['message','font','Font','-*-Times-Medium-R-Normal-*-180-*-*-*-*-*-*'],
                      DEFAULT     => ['message',undef,undef,undef]

		     );
}


# Display the dialogue.
sub show {

    my($cw, $grab_type) = @_;

    my $old_focus = $cw->focusCurrent;

    # Update all geometry information, center the dialog in the display
    # and deiconify it

    $cw->Popup(); 

    # set a grab and claim the focus.

    if (defined $grab_type && length $grab_type) {
        $cw->grab($grab_type);
    } else {
        $cw->grab;
    }
    $cw->tkwait('visibility', $cw);
    if (defined $cw->{'default_button'}) {
	$cw->{'default_button'}->focus;
    } else {
	$cw->focus;
    }

    # Wait for the user to respond, restore the focus and grab, withdraw
    # the dialog and return the label of the selected button.

    $cw->tkwait('variable' => \$cw->{'selected_button'});
    $cw->grab('release');
    eval { $old_focus->focus } if defined $old_focus;
    $cw->withdraw;

    return $cw->{'selected_button'};

}

sub errorDialogue {

    my ($w, $message)=@_;

    $w->MessageBox (-font => '*times*bold-r*20*',
		    -title => 'Error...!',
		    -justify => 'left',
		    -wraplength => '7i',
		    -text => $message,
		    -bitmap => 'warning',
		    -buttons => ['OK']
		    )->show();

}

sub infoDialogue {

    my ($w, $message)=@_;

    $w->MessageBox(
	       -font => '*times*bold-r*20*',
	       -title => 'Info.',
	       -justify => 'left',
	       -wraplength => '7i',
	       -text => $message,
	       -bitmap => 'info',
	       -buttons => ['OK']
	       )->show();

}



1;




