view release on metacpan or  search on metacpan

lib/Tk/QuickForm.pm  view on Meta::CPAN

	my $self = shift;
	my $holder = shift;
	my $class = shift;
	eval "require $class";
	while ($class =~ s/.*[\:\:]//) {}
	return $holder->$class(@_);
}

=item B<createForm>

Call this method after you created the B<Tk::QuickForm> widget.
It will create all the pages, sections and entries.

=cut

sub createForm {
	my $self = shift;
	my @holderstack = ({
		offset => 0,
		holder => $self,
		row => 0,
		type => 'root',
	});
	my $notebook;
	my $popcolor;

	my $structure = $self->cget('-structure');
	my @options = @$structure;
	my $labelwidth = 0;
	while (@options) {
		my $key = shift @options;
		if (($key eq '*page') or ($key eq '*section')) {
			shift @options;
			next;
		}
		next if ($key eq '*end') or ($key eq '*column') or ($key eq '*expand') or ($key eq '*frame');
		my $conf = shift @options;
		my $l = length $conf->[1];
		unless ($conf->[0] eq 'ext2') { $labelwidth = $l if $l > $labelwidth; }
	}

	my %options = ();
	my %labels = ();
	my @padding = (-padx => 2, -pady => 2);

	@options = @$structure;
	while (@options) {
		my $key = shift @options;

		if ($key eq '*page') {
			my $label = shift @options;
			my $holder = $holderstack[0]->{holder};
			my $row = $holderstack[0]->{row};
			unless (defined $notebook) {
				$holder->gridRowconfigure($row, -weight => 1);
				$notebook = $holder->NoteBook(
# 					-borderwidth => 1,
				)->grid(
					-column => 0, 
					-row => $row, 
					-columnspan => 2, 
					-sticky => 'nsew'
				);
				$self->{NOTEBOOK} = $notebook;
			}
			my $page = $notebook->add($label, -label => $label);
			my $h = $page->Frame->pack(-fill => 'x');
			$h->gridColumnconfigure(1, -weight => 1);
			$holderstack[0]->{row} ++;
			unshift @holderstack, {
				holder => $h,
				offset => 0,
				row => 0,
				type => 'page',
			};

		} elsif ($key eq '*section') {
			my $label = shift @options;
			my $h = $holderstack[0];
			my $offset = $h->{offset};
			my $lf = $h->{holder}->LabFrame(
				-label => $label,
				-labelside => 'acrosstop',
			)->grid(@padding, -column => 0 + $offset, -row => $h->{row}, -columnspan => 2, -sticky => 'nsew');
			$lf->gridColumnconfigure(1, -weight => 1);
			$holderstack[0]->{row} ++;
			unshift @holderstack, {
				holder => $lf,
				offset => 0,
				row => 0,
				type => 'section',
			};
			
		} elsif ($key eq '*frame') {
			my $h = $holderstack[0];
			my $offset = $h->{offset};
			my $f = $h->{holder}->Frame->grid(@padding, 
				-column => 0 + $offset, 
				-row => $h->{row}, 
				-columnspan => 2, 
				-sticky => 'nsew',
			);
			$f->gridColumnconfigure(1, -weight => 1);
			$holderstack[0]->{row} ++;
			unshift @holderstack, {
				holder => $f,
				offset => 0,
				row => 0,
				type => 'frame',
			};
			
		} elsif ($key eq '*column') {
			my $offset = $holderstack[0]->{offset};
			$offset = $offset + 2;
			$holderstack[0]->{offset} = $offset;
			$holderstack[0]->{row} = 0;
			my $h = $holderstack[0]->{holder};
			$h->gridColumnconfigure(1 + $offset, -weight => 1);
		} elsif ($key eq '*end') {
			if ($holderstack[0]->{type} eq 'page') {
				$notebook = undef
			}
			if  (@holderstack > 1) {
				shift @holderstack
			} else {
				warn "Holder stack is already empty"
			}
		} elsif ($key eq '*expand') {
			my $holder = $holderstack[0]->{holder};
			my $row = $holderstack[0]->{row};
			my $count = 0;
			while (defined $holderstack[$count]) {
				my $htype = $holderstack[$count]->{type};
				if ($htype eq 'page') {
					my $h = $holderstack[$count]->{holder};
					$h->packForget;
					$h->pack(-expand => 1, -fill => 'both');
					last
				}
				$count ++;
			} 
			$holder->gridRowconfigure($row, -weight => 1);
			
		} else {
			my $conf = shift @options;
			my @opt = @$conf;
			my $type = shift @opt;
			my $row = $holderstack[0]->{row};
			my $holder = $holderstack[0]->{holder};
			my $offset = $holderstack[0]->{offset};

			if ($type eq 'color') {
				my $file = $self->cget('-colorhistoryfile');
				$popcolor = $self->PopColor() unless defined $popcolor;
				push @opt, -popcolor => $popcolor, -historyfile => $file;
			}


			if ($type eq 'ext1') {
				my $label = shift @opt;
				my $class = shift @opt;
				my $l = $holder->Label(
					-width => $labelwidth, 
					-text => $label, 
					-anchor => 'e'
				)->grid(@padding,
					-column => 0 + $offset,
					-row => $row, 
					-sticky => 'e'
				);
				my $w = $self->CreateClass($holder, $class, -quickform => $self, -validatecall => ['validate', $self], @opt);
				$w->grid(
					-column => 1 + $offset,
					-row => $row, 
					-sticky => 'nsew',
					-padx => 2,
					-pady => 2
				);
				$options{$key} = $w;
				$labels{$key} = $l;
			} elsif ($type eq 'ext2') {
					# $label is now actually the reference to the external object
					# $values is now actually a boolean scalar to instruct the widget to expand
					my $class = shift @opt;
					my $w = $self->CreateClass($holder, $class, -validatecall => ['validate', $self], @opt);
					$w->grid(
					-column => 0, 
					-row => $row, 
					-columnspan => 2 + $offset,
					-sticky => 'nsew',
					-padx => 2,
					-pady => 2
				);
				$options{$key} = $w;
			} else {
				my $label = shift @opt;
				my $l = $holder->Label(
					-width => $labelwidth,
					-text => $label,
					-anchor => 'e'
				)->grid(@padding,
					-column => 0 + $offset, 
					-row => $row, -sticky => 'e'
				);
				my $t = $self->{TYPES}->{$type};
				my @o = @$t;
				my $class = shift @o;
				my %opthash = (@o);
				while (@opt) {
					my $key = shift @opt;
					my $value = shift @opt;
					$opthash{$key} = $value;
				}
				$opthash{'-validatecall'} = ['validate', $self];
				my $img = $opthash{'-image'};
				if ((defined $img) and ($img =~ /^-/)) {
					$opthash{'-image'} = $self->cget($img)
				}

				if (exists $opthash{'-values'}) {
					my $values = $opthash{'-values'};
					if ((ref $values) and ($values =~/^CODE/))  {
						my @vals = &$values;
						$opthash{'-values'} = \@vals;
					}
				}
				
				my $widg = $self->CreateClass($holder, $class, %opthash, -quickform => $self)->grid(
					-column => 1 + $offset, 
					-row => $row,
					-sticky => 'nsew', 
					-padx => 2, -pady => 2
				);

				$options{$key} = $widg;
				$labels{$key} = $l;
				$holderstack[0]->{row} ++;
			}
		}
	}
	$self->{OPTIONS} = \%options;
	$self->{LABELS} = \%labels;
	$self->{NOTEBOOK} = $notebook;
	$self->after(10, ['validate', $self]);
	return $notebook;
}

sub DefineTypes {
	my $self = shift;