view release on metacpan or  search on metacpan

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

package Tk::FileManager;

=head1 NAME

Tk::FileManager - Tk::FileBrowser based filemanager

=cut

use strict;
use warnings;
use vars qw($VERSION);
$VERSION = 0.12;

use base qw(Tk::Derived Tk::FileBrowser);
Construct Tk::Widget 'FileManager';

use Config;
my $mswin = $Config{'osname'} eq 'MSWin32';

use File::Basename;
use File::Copy;
require Tk::HList;
require Tk::YADialog;
require Tk::YAMessage;


=head1 SYNOPSIS

 require Tk::FileManager;
 my $m = $window->FileManager(@options)->pack;
 $m->load($folder);

=head1 DESCRIPTION

Inherits L<Tk::FileBrowser>.

Adds some file manager functionality. A clipboard function.

=head1 ADVERTISED SUBWIDGETS

=over 4

=item B<Notifier>

=item B<DeleteDialog>

=item B<DeleteList>

=back

=head1 KEYBINDINGS

=over 4

=item B<CTRL+C>

Copies selected files and folders to the clipboard.

=item B<CTRL+V>

Pastes files and folders in the clipboard to the current location.

=item B<CTRL+X>

Copies selected files and folders to the clipboard. Files are deleted after a paste.

=item B<Delete>

Move selected files and folders to the trash bin. (Not yet functional)

=item B<Shift+Delete>

Permanently delete selected files and folders. Pops a confirm dialog first.

=back

=over 4

=cut

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

	my $mode = delete $args->{'-selectmode'};
	$mode = 'extended' unless defined $mode;
	$args->{'-selectmode'} = $mode;
	$args->{'-createfolderbutton'} = 1;

	$self->SUPER::Populate($args);
	
	$self->clipboardClear;
	$self->cutOperation(0);

	my $tree = $self->Subwidget('LB');
	my $c = $tree->Subwidget('Canvas');
	$c->Tk::bind('<Control-c>', [$self, 'clipboardCopy']);
	$c->Tk::bind('<Control-x>', [$self, 'clipboardCut']);
	$c->Tk::bind('<Control-v>', [$self, 'clipboardPaste']);
	$c->Tk::bind('<Delete>', [$self, 'trash']);
	$c->Tk::bind('<Shift-Delete>', [$self, 'delete']);
	
	my $not = $self->Label(
		-anchor => 'w',
	);
	$self->Advertise('Notifier', $not);
	my $fg = $not->cget('-foreground');

	my $deldialog = $self->YADialog(
		-buttons => ['Ok', 'Cancel'],
		-defaultbutton => 'Ok',
	);
	my @padding = (-padx => 2, -pady => 2);
	my $df = $deldialog->Frame->pack(-fill => 'x');
	my $ilab = $df->Label->pack(-side => 'left', @padding);
	$self->after(300, sub { $ilab->configure(-image => $self->cget('-warnimage')) });
	$df->Label(-text => 'Deleting the following files and folders:')->pack(-side => 'left', @padding);
	my $dellist = $deldialog->Scrolled('HList',
		-scrollbars => 'osoe',
		-separator => '`',
		-width => 75,
	)->pack(-expand => 1, -fill =>'both', @padding);
	$self->Advertise('DeleteDialog', $deldialog);
	$self->Advertise('DeleteList', $dellist);

#	$self->ConfigSpecs(
#	);
}

sub clipboard {
	my $self = shift;
	$self->{CLIPBOARD} = \@_ if @_;
	my $c = $self->{CLIPBOARD};
	return @$c
}

sub clipboardClear {
	my $self = shift;
	$self->{CLIPBOARD} = [];
}

sub clipboardCopy {
	my $self = shift;
	$self->clipboardClear;
	$self->cutOperation(0);
	$self->clipboard($self->collect);
}

sub clipboardCut {
	my $self = shift;
	$self->clipboardClear;
	$self->cutOperation(1);
	$self->clipboard($self->collect);
}

sub clipboardPaste {
	my $self = shift;
	my @files = $self->clipboard;
	for (@files ) {
		return 0 unless $self->fileCopy($_);
	}
	if ($self->cutOperation) {
		for (@files ) {
			return 0 unless $self->fileDelete($_);
		}
	}
	$self->clipboardClear;
	$self->reload;
	return 1
}

sub confirmOverwrite {
	my ($self, $destination) = @_;
	my $write = 'Overwrite';
	$write = 'Write into' if -d $destination;
	my $action = $self->popDialog(
		-image => 'warning',
		-text => "Destination exists\n$destination",
		-buttons => ['Skip', $write, 'Cancel'],
		-defaultbutton => $write,
	);
	$self->notifyClear;
	return 0 if $action =~ /Cancel/;
	return 1 if $action eq 'Skip';
	return 2 if $action eq $write;
}

sub cutOperation {
	my $self = shift;
	$self->{CUTOPERATION} = shift if @_;
	return $self->{CUTOPERATION}
}

sub delete {
	my $self = shift;
	my @items = $self->collect;
	if ($self->deleteConfirm(@items)) {
		for (@items) {
			return 0 unless $self->fileDelete($_); 
		}
	}
	$self->reload;
}

sub deleteConfirm {
	my $self = shift;
	my $dd = $self->Subwidget('DeleteDialog');
	my $dl = $self->Subwidget('DeleteList');
	$dl->deleteAll;
	for (@_) {
		my $item = $_;
		my $image;
		if (-d $item) {
			$image = $self->Callback('-diriconcall', $item, 'compact');
		} else {
			$image = $self->Callback('-fileiconcall', $item, 'compact');
		}
		$dl->add($item, -itemtype => 'imagetext', -image => $image, -text => $item);
	}
	my $confirm = $dd->show(-popover => $self->toplevel);
	return 1 if $confirm eq 'Ok';
	return 0
}

sub fileCopy {
	my ($self, $source, $destination) = @_;
	$destination = $self->folder unless defined $destination;