## ctk: description Enter configSpec definitions
## ctk: title ConfigSpec
## 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{ 1 }
## ctk: Toplevel  1
## ctk: argList -title , 'ConfigSpec' ,-buttons, [qw/ok cancel/]                             
## ctk: 2007 12 11 - 12:24:09

use strict;
use Tk;


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

my ($className,$dbName,$defaultValue,$optionsList,$optionsName,$optionsTyp,$widgetRef);

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

## ctk: gcode
$optionsList = {};

$className = $dbName = $widgetRef= $defaultValue= $optionsName = undef;
## ctk: gcode
}
sub Populate {
	my ($self,$args) = @_;
##
## ctk: Localvars
## ctk: Localvars end
	$optionsList = {};

	$className = $dbName = $widgetRef= $defaultValue= $optionsName = 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_002,
$wr_005,
$wr_007,
$wr_009,
$wr_010,
$wr_011,
$wr_014,
$wr_015,
$wr_017,
$wr_019,
$wr_020,
$wr_024,
$wr_026,
$wr_028,
$wr_030,
$wr_032,
$wr_037,
$wr_039,
$wr_041
);
## ctk: instantiate and display widgets 

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


$wr_009 = $mw -> LabFrame ( -label , 'Options' , -labelside , 'acrosstop'  ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'both', -expand=>1);


$wr_030 = $wr_001 -> LabFrame ( -label , '<where>' , -relief , 'ridge' , -labelside , 'acrosstop'  ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);


$wr_010 = $wr_009 -> Frame ( -borderwidth , 1 , -relief , 'flat'  ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'both', -expand=>1);


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


$wr_024 = $wr_001 -> LabFrame ( -label , '<class>, <DB> and <default>' , -relief , 'ridge' , -labelside , 'acrosstop'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);


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

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


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


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


$wr_019 = $wr_024 -> LabEntry ( -background , '#ffffff' , -label , 'Class name' , -labelPack , [-side , 'left' , -anchor , 'n' ] , -state , 'normal' , -justify , 'left' , -relief , 'sunken' , -textvariable , \$className  ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);


$wr_026 = $wr_024 -> LabEntry ( -background , '#ffffff' , -label , 'DB name' , -labelPack , [-side , 'left' , -anchor , 'n' ] , -state , 'normal' , -justify , 'left' , -relief , 'sunken' , -textvariable , \$dbName  ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);


$wr_028 = $wr_024 -> LabEntry ( -background , '#ffffff' , -justify , 'left' , -label , 'Default value' , -relief , 'sunken' , -labelPack , [-side , 'left' , -anchor , 'n' ] , -textvariable , \$defaultValue , -state , 'normal'  ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);


$wr_002 = $wr_030 -> Radiobutton ( -value , 'ADVERTISED' , -relief , 'flat' , -variable , \$optionsTyp , -anchor , 'nw' , -state , 'normal' , -justify , 'left' , -text , 'ADVERTISED'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);


$wr_032 = $wr_030 -> Radiobutton ( -value , 'DESCENDANTS' , -relief , 'flat' , -variable , \$optionsTyp , -anchor , 'nw' , -state , 'normal' , -justify , 'left' , -text , 'DESCENDANTS'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);


$wr_005 = $wr_030 -> Radiobutton ( -value , 'CALLBACK' , -relief , 'flat' , -variable , \$optionsTyp , -anchor , 'nw' , -state , 'normal' , -justify , 'left' , -text , 'CALLBACK'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);


$wr_007 = $wr_030 -> Radiobutton ( -value , 'CHILDREN' , -relief , 'flat' , -variable , \$optionsTyp , -anchor , 'nw' , -state , 'normal' , -justify , 'left' , -text , 'CHILDREN'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);


$wr_014 = $wr_030 -> Radiobutton ( -value , 'METHOD' , -relief , 'flat' , -variable , \$optionsTyp , -anchor , 'nw' , -state , 'normal' , -justify , 'left' , -text , 'METHOD'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);


$wr_037 = $wr_030 -> Radiobutton ( -value , 'SELF' , -relief , 'flat' , -variable , \$optionsTyp , -anchor , 'nw' , -state , 'normal' , -justify , 'left' , -text , 'SELF'  ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);


$wr_039 = $wr_030 -> LabEntry ( -background , '#ffffff' , -label , 'Widget ref' , -foreground , '#ffffff' , -labelPack , [-side , 'left' , -anchor , 'n' ] , -state , 'normal' , -justify , 'left' , -textvariable , \$widgetRef  ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);


## ctk: end of gened Tk-code

## ctk: public subwidgets
$self->Advertise('optionslist'=>$wr_020);
## ctk: public subwidgets end
## 	 set up Delegate 	(optional)
	return $self;
}
## ctk: methods
sub emptyItem {
	my $self = shift;
	my ($name) = @_;
	&main::trace("emptyItem");
	$name =~ s/^-//;
	my $rv = {-where, 'SELF',-classname, $name,-dbname , $name, -default , 0};
	return $rv
}
sub optionsList { 
	my $self = shift;
	my ($args) = @_;
	&main::trace("optionsList");
	return $optionsList unless (@_) ;
	map {
		$optionsList->{$_} = $args->{$_}
	} keys %$args;
	return $optionsList;
}
sub addOption {
	my $self = shift;
	my $name = '';
	&main::trace("addOption");
	my $listbox = $self->Subwidget('optionslist');
	$name = &std::dlg_getSingleValue($self,$name,"Get option's name");
	if (defined($name)) {
		$name =~ s/\s+//; $name=~s/\s+$//;
		return undef if exists $optionsList->{$name};
		if ($name) {
			$listbox->insert('end',$name);
			$listbox->selectionClear(0,'end');
			$listbox->selectionSet('end');
			$self->saveChanges;
			$optionsList->{$name} = $self->emptyItem($name);
			&prepareEditFrame($listbox,$self);
		} else {}
	} else {
	}
}
sub deleteOption {
	my $self = shift;
	my $listbox = $self->Subwidget('optionslist');
	&main::trace("deleteOption");
	my @sel = $listbox->curselection();
	map {
		my $name = $listbox->get($_);
		$listbox->delete($_);
		delete $optionsList->{$name};
	} reverse @sel;
	$listbox->selectionSet('end');	
	undef $optionsName;
	&prepareEditFrame($listbox,$self);
}
sub editOption {
	my $self = shift;
	&main::trace('editOption');
	my $listbox = $self->Subwidget('optionslist');
	my @sel = $listbox->curselection();
	my $name = $listbox->get($sel[0]);
	my $nameOld = $name;
	$name = &std::dlg_getSingleValue($listbox,$name,"Get option'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);
			$optionsList->{$name} = delete $optionsList->{$nameOld};
			$optionsName = $name;
		}
	}
	&main::trace("listbox @sel");
}		
sub prepareEditFrame {
	my ($listbox, $self) = @_;
	&main::trace('prepareEditFrame');
	my @sel = $listbox->curselection();
	$self->saveChanges;
	if (@sel) {
		$optionsName = $listbox->get($sel[0]);
		my $opt = $optionsList->{$optionsName};
		if ($opt->{-where} =~ /^\$/) {
			$optionsTyp = '';
			$widgetRef = $opt->{-where}
		} else {
			$optionsTyp = $opt->{-where};
			$widgetRef = ''
		}
		$className = $opt->{-classname};
		$dbName = $opt->{-dbname};
		$defaultValue = $opt->{-default};			
	}
}
sub saveChanges {
	my $self = shift;
	&main::trace('saveChanges');
	return 0 unless defined $optionsName;
	if (exists $optionsList->{$optionsName}) {
		if ($widgetRef =~ /\S/) {
			$widgetRef =~ s/^\s+//;$widgetRef =~ s/\s+$//;
			$optionsList->{$optionsName}->{-where} = $widgetRef;
		} else {
			$optionsList->{$optionsName}->{-where} = $optionsTyp;
		}
		$optionsList->{$optionsName}->{-classname} = $className;
		$optionsList->{$optionsName}->{-dbname} = $dbName;
		$optionsList->{$optionsName}->{-default} = $defaultValue;
	} else {}
	$optionsName = undef;
	return 1
}
sub Show {
	my $self = shift;
	my $listbox = $self->Subwidget('optionslist');
		$listbox->insert('end',sort keys %$optionsList);
	my $rv = $self->SUPER::Show(@_);
	$self->saveChanges;	
	return $rv
}
## ctk: methods end
## ctk: other code
## ctk: eof 2007 12 11 - 12:24:09
1;	## make perl compiler happy...

=head1 dlgGetConfigSpec

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

=head2 Base widget

	Tk::DialogBox

=head2 Methods

	ClassInit
	Populate

	emptyItem
	optionsList
	addOption
	deleteOption
	editOption
	prepareEditFrame
	saveChanges

	Show

=head2 Maintenance

		History 11.12.2007 first draft

=cut

