# # -*-Perl-*- 
# 
# TkTextSave
# 
# Save all text from Tk::Text widget to file name			
# Pop up dialogue box for filename
# 
#
# $Id: TkTextSave.pm,v 1.2 1997/04/24 13:10:01 dn1 Exp $
#
# $Log: TkTextSave.pm,v $
# Revision 1.2  1997/04/24  13:10:01  dn1
# Added copyright
#
# Revision 1.1  1996/10/21  11:19:53  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 TkTextSave;
require Tk::Dialog;

sub TkTextSave::saveAs
{

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

    my $top=$w->Toplevel;

    my $title = 'Save As...';
    $top->title($title);
    $top->iconname($title);
    $top->grab;

    #############################
    # 
    # Define Help dialog.
    # 
    #############################

    my $help_text=qq{

  Save as

  Save contents of the text box in a file.

};

    my $dialog_help = $top->Dialog(-font => '*times*bold-r*20*', -wraplength => '7i',
				   -title => 'Help! - Save As...', -justify => 'left',
				   -text => $help_text, -bitmap => 'info'
				   );

   #############################
   # 
   # Labelled entry for getting filename
   # 
   #############################

    my($entry_ref) = TkTextSave::LabelEntry($top, ' Save as: ', '');

   #############################
   # 
   # OK, Help, Cancel...
   # 
   #############################


   my $buttons=$top->Frame ( -borderwidth => 3, -relief => 'flat');
   $buttons->pack(-fill => 'both', -expand => 'yes', -padx => '2', -pady => '2', -side => 'bottom');

   my $ok_button=$buttons->Button ( -text => 'OK', -command => sub { 

       my $contents = $textw->get('1.0', 'end');
       my $file = $entry_ref->get;

       if ( -s "$file" ) {
	   
	       my($yes, $no)=('Yes', 'No');

	       my $existsDialog;
	       if (not Exists($existsDialog)) {
		   
		   $existsDialog = $top->Dialog(
						-font => '*times*bold-r*20*',
						-wraplength => '7i',
						-title => 'File exists',
						-text           => "File $file already exists\nOK to overwrite?",
						-bitmap         => 'warning',
						-default_button => $no,
						-buttons        => [$no, $yes],
						);
	       }
	       
	       my $response = $existsDialog->Show;

	       if ($response eq $no) {
		   return;
	       }
	   }

       open (FILE, ">$file") || warn "Couldn't write to file \"$file\"$!\n";
       print FILE $contents;
       close(FILE);

       $top->destroy;

   }); 

   $ok_button->pack(qw(-side left -expand yes -padx 3m -pady 3m -ipadx 2m -ipady 1m ));


   my $help_button=$buttons->Button ( -text => 'Help...', -command => sub { $dialog_help->Show(); } ); 
   $help_button->pack(qw(-side left -expand yes -padx 3m -pady 3m -ipadx 2m -ipady 1m ));


   my $cancel_button=$buttons->Button ( -text => 'Cancel', -command => sub {$top->destroy } ); 
   $cancel_button->pack(qw(-side left -expand yes -padx 3m -pady 3m -ipadx 2m -ipady 1m ));
    

}



sub TkTextSave::LabelEntry {

    my($w, $label_text, $entry_text)=@_;

    my $frame = $w -> Frame (-borderwidth => 2, -relief => 'groove');
    $frame->pack (-side => 'top', -padx => '2m', -pady => '2m', -ipadx => '1m', -ipady => '1m', -fill => 'x', -expand => 'yes');

    my $label= $frame->Label( -text => $label_text );
    my $entry= $frame->Entry(-width => '35');

    $entry->pack(-side => 'right', -expand => 'yes', -anchor => 'e');
    $label->pack(-side => 'left', -expand => 'yes', -anchor => 'e');

    $entry->bind('<Delete>', Backspace);
    $entry->insert('0',  $entry_text);

    return $entry;

}

1;




