## ctk: description Enter Delegate methods
## ctk: title Delegate
## ctk: application '' ''
## ctk: strict  1
## ctk: code  3
## ctk: testCode  0
## ctk: subroutineName dlgGetConfigSpec
## ctk: autoExtractVariables  0
## ctk: autoExtract2Local  0
## ctk: modalDialogClassName DialogBox
## ctk: modal 1
## ctk: baseClass  Tk::DialogBox
## ctk: isolGeom 0
## ctk: version 4.001
## ctk: onDeleteWindow  sub{exit}
## ctk: Toplevel  0
## ctk: argList -title , 'Delegate' ,-buttons,[qw/Ok Cancel/]  
## ctk: 2007 12 11 - 12:22:34

use strict;
use Tk;


package ctkDlgDelegate;
use vars qw($VERSION);
$VERSION = '1.01';
require Tk::DialogBox;
require Tk::Derived;
@ctkDlgDelegate::ISA = qw(Tk::Derived Tk::DialogBox);
Construct Tk::Widget 'ctkDlgDelegate';
## ctk: Globalvars

my ($delegateList,$methodName,$subwidgetName,$subwidgetRef);

## ctk: Globalvars end
sub ClassInit {
	my $self = shift;
##
## 	init class
##
	$self->SUPER::ClassInit(@_);

## ctk: gcode
	$delegateList = {};
	$methodName = $subwidgetName = $subwidgetRef = undef;
## ctk: gcode
}
sub Populate {
	my ($self,$args) = @_;
##
## ctk: Localvars
## ctk: Localvars end
## 	move args to local variables)
	$delegateList = {};
	$methodName = $subwidgetName = $subwidgetRef = undef;
##
	$self->SUPER::Populate($args);
##
## 	 set up ConfigSpecs 	(optional)
##
my $mw = $self;
## ctk: code generated by ctk_w version '4.001' 
## ctk: lexically scoped variables for widgets 

my (
$wr_001,
$wr_009,
$wr_010,
$wr_011,
$wr_012,
$wr_015,
$wr_017,
$wr_018,
$wr_019,
$wr_020,
$wr_026,
$wr_028
);
## ctk: instantiate and display widgets 

$wr_001 = $mw -> LabFrame ( -label , 'Delegate' , -relief , 'solid' , -labelside , 'acrosstop'  ) -> pack(-side=>'right', -anchor=>'nw', -fill=>'both', -expand=>1);


$wr_009 = $mw -> Frame ( -relief , 'solid'  ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'both', -expand=>1);


$wr_018 = $wr_001 -> Label ( -justify , 'left' , -text , 'Ref to subwidget' , -relief , 'flat'  ) -> grid(-row=>0, -sticky=>'nw', -column=>0);


$wr_019 = $wr_001 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$subwidgetRef , -state , 'normal'  ) -> grid(-row=>0, -column=>1, -sticky=>'nw');


$wr_010 = $wr_009 -> LabFrame ( -label , 'Methods' , -relief , 'ridge' , -labelside , 'acrosstop'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'both', -expand=>1);


$wr_011 = $wr_009 -> LabFrame (  ) -> pack(-side=>'bottom', -anchor=>'sw', -fill=>'x', -expand=>1);


$wr_026 = $wr_001 -> Label ( -justify , 'left' , -text , 'Name of  subwidget' , -relief , 'flat'  ) -> grid(-row=>1, -sticky=>'nw', -column=>0);


$wr_028 = $wr_001 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$subwidgetName , -state , 'normal'  ) -> grid(-row=>1, -column=>1, -sticky=>'nw');


$wr_020 = $wr_010 -> Scrolled ( 'Listbox' , -background , '#ffffff' , -height , 10 , -selectmode , 'single' , -relief , 'ridge' , -scrollbars , 'se'  ) -> pack(-side=>'top', -anchor=>'nw', -pady=>5, -fill=>'both', -expand=>1, -padx=>5);
$wr_020->insert('end', (sort keys %$delegateList));
$wr_020->bind('<1>',[\&prepareEditFrame,$self]);

$wr_015 = $wr_011 -> Button ( -background , '#ffffff' , -command , [\&addMethod , $self ] , -state , 'normal' , -relief , 'raised' , -text , 'Add '  ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'x', -expand=>1, -padx=>2);


$wr_012 = $wr_011 -> Button ( -background , '#ffffff' , -command , [\&editMethod , $self ] , -state , 'normal' , -text , 'Edit' , -relief , 'raised'  ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'x', -expand=>1, -padx=>2);


$wr_017 = $wr_011 -> Button ( -background , '#ffffff' , -command , [\&deleteMethod , $self ] , -state , 'normal' , -relief , 'raised' , -text , 'Delete'  ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'x', -expand=>1, -padx=>2);


## ctk: end of gened Tk-code

## ctk: public subwidgets
$self->Advertise('delegatelist'=>$wr_020);
## ctk: public subwidgets end
## 	 set up Delegate 	(optional)
	return $self;
}
## ctk: methods
sub emptyItem {
	my $self = shift;
	my ($name) = @_;
	return { -subwidgetref, ' ', -subwidgetname , ' ' }
}
sub delegateList {
	my $self = shift;
	my ($args) = @_;
	&main::trace("delegateList");
	return $delegateList unless (@_) ;
	map {
		$delegateList->{$_} = $args->{$_}
	} keys %$args;
	return $delegateList;
}
sub addMethod {
	my $self = shift;
	my $name = '';
	&main::trace("addMethod");
	my $listbox = $self->Subwidget('delegatelist');
	$name = &std::dlg_getSingleValue($self,$name,"Get method's name");
	if (defined($name)) {
		$name =~ s/\s+//; $name=~s/\s+$//;
		return undef if exists $delegateList->{$name};
		if ($name) {
			$listbox->insert('end',$name);
			$listbox->selectionClear(0,'end');
			$listbox->selectionSet('end');
			$self->saveChanges;
			$delegateList->{$name} = $self->emptyItem($name);
			&prepareEditFrame($listbox,$self);
		} else {}
	} else {
	}
}
sub deleteMethod {
	my $self = shift;
	my $listbox = $self->Subwidget('delegatelist');
	&main::trace("deleteMethod");
	my @sel = $listbox->curselection();
	map {
		my $name = $listbox->get($_);
		$listbox->delete($_);
		delete $delegateList->{$name};
	} reverse @sel;
	$listbox->selectionSet('end');
	undef $methodName;
	&prepareEditFrame($listbox,$self);
}
sub editMethod {
	my $self = shift;
	&main::trace('editMethod');
	my $listbox = $self->Subwidget('delegatelist');
	my @sel = $listbox->curselection();
	my $name = $listbox->get($sel[0]);
	my $nameOld = $name;
	$name = &std::dlg_getSingleValue($listbox,$name,"Edit method's name");
	if (defined $name) {
		$name =~ s/\s+//; $name=~ s/\s+$//;
		if ($name && ($name ne $nameOld)) {
			$listbox->delete($sel[0]);
			$listbox->insert($sel[0],$name);
			$delegateList->{$name} = delete $delegateList->{$nameOld};
			$methodName = $name;
		}
	}
	&main::trace("listbox @sel");
}
sub prepareEditFrame {
	my ($listbox, $self) = @_;
	&main::trace('prepareEditFrame');
	my @sel = $listbox->curselection();
	$self->saveChanges;
	if (@sel) {
		$methodName = $listbox->get($sel[0]);
		my $opt = $delegateList->{$methodName};
		$subwidgetRef = $opt->{-subwidgetref};
		$subwidgetName = $opt->{-subwidgetname}
	}
}
sub saveChanges {
	my $self = shift;
	&main::trace('saveChanges');
	return 0 unless defined $methodName;
	if (exists $delegateList->{$methodName}) {
		if ($subwidgetRef =~ /\S/) {
			$subwidgetRef =~ s/^\s+//;$subwidgetRef =~ s/\s+$//;
			$delegateList->{$methodName}->{-subwidgetref} = $subwidgetRef;
			$delegateList->{$methodName}->{-subwidgetname} = ' ';
		} elsif ($subwidgetName =~ /\S/){
			$subwidgetName =~ s/^\s+//;$subwidgetName =~ s/\s+$//;
			$delegateList->{$methodName}->{-subwidgetname} = $subwidgetName;
			$delegateList->{$methodName}->{-subwidgetref} = ' ';
		} else{
			$delegateList->{$methodName}->{-subwidgetname} = ' ';
			$delegateList->{$methodName}->{-subwidgetref} = ' ';
		}
	} else {}
	$methodName = undef;
	return 1
}
sub Show {
	my $self = shift;
	my $listbox = $self->Subwidget('delegatelist');
		$listbox->insert('end',sort keys %$delegateList);
	my $rv = $self->SUPER::Show(@_);
	$self->saveChanges if($rv =~ /ok/i);
	return $rv
}
## ctk: methods end
## ctk: other code
## ctk: eof 2007 12 11 - 12:22:34
1;	## make perl compiler happy...

=head1 ctkDlgDelegate

	Set up a modal dialog to enter data for the method Delegates.

=head2 Base widget

	Tk::DialogBox

=head2 Methods

	ClassInit
	Populate
	emptyItem
	delegateList
	addMethod 
	deleteMethod 
	editMethod 
	prepareEditFrame 
	saveChanges 
	Show 

=head2 Maintenance

		History 11.12.2007 first draft

=cut

