#######################################################################
# 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.                      #
########################################################################
#
# tk_tools.pl
#
#  
#  - Subroutine toolkit for multiple widget constructs
#
# 13-Sep-1995 Created -- DMH
#



sub labelEntry {

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

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

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

    $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);

}

############################################################
# ($entry_ref, $check_var_ref) = &checkLabelEntry ($w, $label_text, $entry_text, $active)
# 
#  - Create checked labelled entry box in frame $w. 
#  - $label_text appears between the checkbutton and the entry box. 
#  - $entry_text appears entered in the entry box
#  - Frame comes up as $active (boolean).
#  - User clicks Btn-1 to activate
#
############################################################

sub checkLabelEntry {

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

    # Frame the whole thing

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

    # Place labelled checkbutton


    my $check=$frame->Checkbutton (-text => $label_text,
				   -variable => \$check_var, 
				   -activebackground => 'grey85',
				   -relief => 'flat');
    $check->pack (-side => 'left', -expand => 'yes', -anchor => 'w');

    # Place entry box

    my $entry=$frame->Entry ( -width => '12',  -foreground => 'grey50');
    $entry->insert('0', $entry_text);
    $entry->pack ( -side => 'left', -expand => 'yes', -anchor => 'e');
    $entry->bind('<Delete>', Backspace);

    &toggleActive($check_var, $check, $entry, $w) unless $active;

    $check->bind('<Button-1>', sub { &toggleActive($check_var, $check, $entry, $w)} );
    $entry->bind('<Button-1>', sub { &toggleActive($check_var, $check, $entry, $w)} );

    return($entry, \$check_var);
}

sub toggleActive {

    my($check_var, $check, $entry, $w)=@_;
    
    if (defined($check_var) && $check_var==1) {
	$check->configure( -foreground => 'black', -activeforeground => 'black');
	$entry->configure( -foreground => 'black',  -state => 'normal');
	$entry->focus;
    } else {
	$check->configure( -foreground => 'grey50', -activeforeground => 'grey50');
	$entry->configure( -foreground => 'grey50', -state => 'disabled');
	$check_var=0;
	$w->focus;
    }

}

1;

# Local Variables:
# mode:perl
# End:


