# # -*-Perl-*- 
#######################################################################
# 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.                      #
#######################################################################
# 
# FormEdit 
#
# $Id: FormEdit.pm,v 1.8 1997/09/04 18:17:38 sd Exp $
#
# $Log: FormEdit.pm,v $
# Revision 1.8  1997/09/04  18:17:38  sd
# Odd number of elements in hash lists
#
# Revision 1.7  1997/06/14  17:18:41  sd
# Moved copyright.
#
# Revision 1.6  1997/04/24  10:15:18  dn1
# Added copyright
#
# Revision 1.5  1996/08/09  08:34:26  dmh
# Changes to support 'New.." button and auto key allocation
#
# Revision 1.4  1996/05/18  13:02:54  dmh
# Totally restructured.
# Call verification methods
#
# Revision 1.3  1996/05/14  16:17:46  dmh
# Calls verfiyRecord from inherited Sheet.pm
#
# Revision 1.2  1996/04/19  09:35:16  dmh
# New record keeps previous record's values as defaults
#
#

package Tk::FormEdit;
use Carp;
#use strict qw(vars);
require Tk::Toplevel;
require Tk::Dialog;
@Tk::FormEdit::ISA = qw(Tk::Toplevel);

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


my %edit_buffer;
my %entries;

sub Populate {

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

     ##############################
     # 
     # Grab the args
     # 
     ##############################

     foreach (keys(%{$args})) {
	 my $realopt;
	 ($realopt=$_)=~s/^\-//;
	 $this->{$realopt} = $args->{$_};
     }

     my $newRec =  $args->{'-new'};
     my $verifyRec =  $args->{'-verify'};

     undef %$args;

     $this->{'touched'} = 0;

     ##############################
     # 
     # Top title section
     # 
     ##############################

     my $t_titles = $this->Frame;
     $t_titles->pack( -side => 'top', -fill => 'x', -ipady => '3');
     
     $t_titles->Label (-text => 'Editing:', -font => '*times*-r*20*')
	 ->pack(-side => 'left', -ipadx => '10');
     

     $this->{'record_entry'} =$t_titles->Entry (-textvariable => \$this->{'recordname'},
						 -font => '*times*-r*20*', 
						 -state => 'disabled',
						 -bg => 'grey95'
						 );
     $this->{'record_entry'}->pack(-side => 'left', -ipadx => '10');
     $this->{'record_entry'}->bind('<Delete>', Backspace);    

    ##############################
    # 
    # Make the specified amount of entry boxes
    # 
    ##############################

    my $entry_sect = $this->Frame(-relief => 'groove', -borderwidth => '2');
    $entry_sect->pack(-side => 'top', 
		      -fill => 'x', 
		      -ipady => '3',  
		      -ipadx => '10', 
		      -padx => '10',
		      -pady => '5');
    
    # Keep lists of what was made
    %edit_buffer=();
    foreach (@{$this->{'fieldlist_ref'}}) {
	next if &{$this->{'ro'}}($_); # Check if read only

	# $edit_buffer{$_}=$this->{'record_ref'}->{$_};
	$edit_buffer{$_}='';
	$entries{$_} = &formLabelEntry($entry_sect, "$_ :", \$edit_buffer{$_});
    }

     # Now put the data in the entry boxes.
     $this->updateCells($this->{'record_ref'}); 


    # Any key press within the window constitutes a 'touched' record.
     $this->bind('<Key>' =>  sub {
	 $this->{'touched'}=1;
     });


    ##############################
    # 
    # Buttons that do things
    # 
    ##############################

    my $button_sect = $this->Frame(-relief => 'flat', -borderwidth => '2');
    $button_sect->pack( -side => 'bottom', -fill => 'x', -ipady => '3',  -ipadx => '10', -padx => '10', -pady => '5');

     my @packing = qw(-side left -padx 10 -pady 5);

     $button_sect->Button(-text => 'OK', -command => sub {$this->OK})->pack(@packing);
     $button_sect->Button(-text => 'Cancel', -command => sub {$this->destroy})->pack(@packing);
     $button_sect->Button(-text => '<<', -command => sub {$this->previousRecord})->pack(@packing);
     $button_sect->Button(-text => '>>', -command => sub {$this->nextRecord})->pack(@packing);

     $new_but = $button_sect->Button(-text => 'New', 
					-command =>sub {
					    $this->newRecord;
					    });
     $new_but->pack(@packing);

 }

sub OK {

    my $this = shift;

    my $err = $this->writeForm;
    return if $err;

    $this->destroy;
}

sub previousRecord {

    my $this = shift;

    my $err = $this->writeForm;
    return if $err;

    # Get the name and a hash reference to the previous record
    my $rec;
    ($rec, $this->{'record_ref'}) = &{$this->{'prev'}}($this->{'recordname'});
    return unless $this->{'record_ref'};

    # Fill the form with this new record.
    $this->{'recordname'} = $rec;
    $this->updateCells($this->{'record_ref'}); 

}

sub nextRecord {

    my $this = shift;

    my $err = $this->writeForm;
    return if $err;


    # Get the ref to the NEXT record for $this->{'recordname'}
    my $rec;
    ($rec, $this->{'record_ref'}) = &{$this->{'next'}}($this->{'recordname'});
    return unless $this->{'record_ref'};
    
    # This global record
    $this->{'recordname'} = $rec;
    
    # Write this record to the formEntry entry boxes.
    $this->updateCells($this->{'record_ref'}); 
    
}

sub newRecord {

    my $this = shift;
    
    $this->configure(-cursor => 'watch');
    $this->update();

    my $err = $this->writeForm;
    return if $err;
    
    # Write this record to the formEntry entries.
    $this->{'isnew'} =1;
    $this->updateCells($this->{'record_ref'}); 

    $this->configure(-cursor => 'top_left_arrow');
    $this->update();

}

sub writeForm {

    my $this = shift;

    if ($this->{'touched'}) {	
	
	&{$this->{'touch'}}($this->{'recordname'}); # Declare this record touched.
	
	# Verify the values in the edit buffer.
	my @erritems = &{$this->{'verify'}}(\%edit_buffer);

	warn join("\n", @erritems) , "\n";
	return 1 if @erritems;
	
	# If this is a new record
	if ($this->{'isnew'} && defined($this->{'recordname'})) { 

	    # Add this as a new record.
	    &{$this->{'new'}}($this->{'recordname'}, \%edit_buffer);
	} else {

	    # Overwrite the exiting record.
	    $this->writeEditBuffer($this->{'record_ref'});

	    # Update the record in the Edit sheet display.
	    &{$this->{'update'}}($this->{'recordname'});
	}
	
    }

}

sub writeEditBuffer {

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

    # For each in the edit_buffer
    foreach (keys(%edit_buffer)) {	

	# Write the edit buffer.
	$$hash_ref{$_}=$edit_buffer{$_};

    }
}

sub updateCells {

    my ($this, $hash_ref)=@_;
    
    # 
    # $hash_ref will be undefined if we walked off the end of the table
    # 
    if (defined($hash_ref)) {
    
	%edit_buffer=();		# Clear the form's revert buffer

        # For each in the list of column headings
	foreach (@{$this->{'fieldlist_ref'}}) {	

	    next if &{$this->{'ro'}}($_); # Check if read only

            # Assign the value of each entry to the edit_buffer
	    $edit_buffer{$_}=$$hash_ref{$_}; 

	    # Re-bind the entryboxes to point to new values in the edit buffer.
	    $entries{$_}->configure(-textvariable => \$edit_buffer{$_});
	}
	
    } 

    if ($this->{'isnew'}) {

	$this->{'record_entry'}->configure(-state => 'normal');
	$this->{'recordname'} = &{$this->{'newkey'}};

    }

}


sub highlightCell {

    my $item = shift;
    $entries{$item}->configure(-background => 'tomato1');

}



sub unHighlightCell {

    my $item = shift;
    $entries{$item}->configure(-background => 'grey85');
}





sub show {

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


sub formLabelEntry {

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

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

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

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

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

    my $old_focus;
    $entry->bind('<Any-Enter>' => sub {
	$old_focus = $w->focusCurrent;
	shift->focus;
	});

    $entry->bind('<Any-Leave>' => sub {
	$old_focus->focus if $old_focus;
	});


    return $entry;

}



1;




