view release on metacpan or  search on metacpan

lib/Tk/AppWindow/PluginsForm.pm  view on Meta::CPAN

package Tk::AppWindow::PluginsForm;

=head1 NAME

Tk::AppWindow::PluginsForm - Load and unload plugins.

=cut

use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.07';

use base qw(Tk::Derived Tk::Frame);

Construct Tk::Widget 'PluginsForm';

require Tk::LabFrame;
require Tk::Pane;
use Data::Compare;

=head1 DESCRIPTION

This package is a L<Tk::Frame> based megawidget.
It provides a for for loading and unloading plugins
to a L<Tk::AppWindow> based application.

=head1 OPTIONS

=over 4

=item Switch: B<-pluginsext>

A reference to the B<Plugins> extension. Mandatory!

=back

=cut

sub Populate {
	my ($self,$args) = @_;

	my $ext = delete $args->{'-pluginsext'};
	die 'Please specify -pluginsext' unless defined $ext;
	
	$self->SUPER::Populate($args);

	my $lf = $self->LabFrame(
		-label => 'Available plugins',
		-labelside => 'acrosstop',
	)->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2);
	my $pane = $lf->Scrolled('Pane',
		-height => 200,
		-scrollbars => 'oe',
		-sticky => 'nsew',
	)->pack(-expand => 1, -fill => 'both');

	my %plugins = ();
	for ($ext->AvailablePlugins) {
		my $plug = $_;
		my $val = $ext->plugExists($plug);
		$plugins{$plug} = \$val;
		my $f = $pane->Frame(
			-borderwidth => 2,
			-relief => 'groove',
		)->pack(-fill => 'x', -padx => 2, -pady => 2);
		$f->Checkbutton(
# TODO reinstate this after bugfix with plug loading after main loop
			-command => sub {
				if ($val) {
					$ext->plugLoad($plug);
					$self->after(10, sub { $val = '' unless $ext->plugExists($plug) });
				} else {
					$ext->plugUnload($plug);