# # -*-Perl-*- 
# 
# TextBox 
#
#   - Make a new toplevel with text widget and print and save button functions
#
#
#
#######################################################################
# 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::TextBox;
use Carp;
use strict qw(vars);
require Tk::Toplevel;
require Tk::Dialog;
require TkTextSave;
@Tk::TextBox::ISA = qw(Tk::Toplevel);
Tk::Widget->Construct('TextBox');

sub Populate {

    require Tk::Text;

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

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

    my $t_frame = $this->Frame();
    $t_frame->pack(-side => 'top', -expand => 'yes', -fill => 'both');


    $this->{'text'} = $t_frame->Text(-relief => 'sunken', 
			 -bd => '2', 
			 -setgrid => 'true', 
			 -wrap => 'none',
			 -width => 80,
			 -state => 'disabled',
			 -height => 20);

    my $v_scroll = $t_frame->Scrollbar(-command => ['yview', $this->{'text'}]);
    my $h_scroll = $t_frame->Scrollbar(-command => ['xview', $this->{'text'}], -orient => 'horizontal');
    
    $this->{'text'}->configure(-yscrollcommand => ['set', $v_scroll],
		     -xscrollcommand => ['set', $h_scroll]);
    
    $v_scroll->pack(-side => 'right', -fill => 'y');
    $h_scroll->pack(-side => 'bottom', -fill => 'x');
    
    $this->{'text'}->pack(-side => 'left', -expand => 'yes', -fill => 'both');


    my $bot = $this->Frame();
    $bot->pack(-side => 'bottom');

    my $print=$bot->Button( -text => 'Print...', -command => [\&printText, $this, $this->{'text'}]);
    $print->pack(-side => 'left', -padx => '10', -pady => '5');

    my $save=$bot->Button( -text => 'Save as...', -command => sub { TkTextSave::saveAs($this, $this->{'text'})});
    $save->pack(-side => 'left', -padx => '10', -pady => '5');
    
    my $close=$bot->Button( -text => 'Close', -command => sub { $this->destroy} );
    $close->pack(-side => 'left', -padx => '10', -pady => '5');

   
    $this->Advertise('text' => $this->{'text'} );
    $this->ConfigSpecs(DEFAULT => [$this->{'text'}]);
    $this->Delegates(DEFAULT => $this->{'text'});

    # Put the text in it
    $this->putText($args->{'-text'});

}

sub enableText {

    my ($this)=@_;
    $this->{'text'}->configure( -state => 'normal' );
}

sub disableText {

    my ($this)=@_;
    $this->{'text'}->configure( -state => 'disabled' );
}

sub clearText {

    my ($this)=@_; 

    $this->enableText();
    $this->{'text'}->delete('1.0', 'end');
    $this->disableText();

}

sub putText {

    my ($this, $string)=@_;
    
    $this->clearText();
    $this->appendText($string);

}

sub appendText {

    my ($this, $string)=@_;

    $this->enableText();
    $this->{'text'}->insert('end', $string);
    $this->disableText();

}

sub getText {

    my ($this)=@_;
    return $this->{'text'}->get('1.0', 'end');
}


sub show {

    my($this) = @_;
    $this->update(); 

} 

sub printText {

    my ($this)=@_;

    my $top=$this->Toplevel;

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

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

    my $help_text=qq{

 Enter print command.
    
 Enter the command to print the report in the output window.

 Typically this will be simply 'lpr', 
  or lpr -P{printer name}.

};

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


   #############################
   # 
   # Labelled entry
   # 
   #############################

    my($entry_ref) = &myLabelEntry($top, ' Print command: ', ' lpr');

   #############################
   # 
   # 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 = $this->{'text'}->get('1.0', 'end');
       my $printer = $entry_ref->get;

       `echo '$contents' |$printer`;

       $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('-global'); } ); 
   $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 myLabelEntry {

    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;

