Mastering Perl/Tk

Tk::MacCopy

This widget simulates a Macintosh file copy dialog. It uses a CollapsableFrame widget to hide copy details, and a MacProgressBar widget to indicate progress of the copy. See Figure C-2.

Figure C-2. Tk::MacCopy, shown with the CollapsableFrame both hidden and viewable

Here’s the code:

$Tk::MacCopy::VERSION = '1.0'; package Tk::MacCopy; use File::Copy; use Tk::widgets qw/CollapsableFrame LabEntry MacProgressBar/; use base qw/Tk::Toplevel/; use strict; Construct Tk::Widget 'MacCopy'; sub Populate { # Create an instance of a MacCopy widget. Instance variables are: # # {bytes_msg} = a string showing how many bytes copied, # as well as the total byte count. # {file} = current file being copied. # {file_count} = number of files left to copy. # {from} = source directory path. # {to} = destination directory path. my($self, $args) = @_; $self->withdraw; $self->SUPER::Populate($args); $args->{-width} = 300 unless exists $args->{-width}; my $pb = $self->MacProgressBar(%$args)->pack; # Populate the top Frame of the MacProgessBar. my $tf = $pb->Subwidget('tframe'); $tf->Label(-text => 'Items remaining to be copied: ')-> pack(qw/-side left -anchor w/); $tf->Label(-textvariable => \$self->{file_count})-> pack(qw/-side right -anchor e/); # Populate the right Frame of the MacProgessBar. my $rf = $pb->Subwidget('rframe'); $rf->Button(-text => 'Stop', -command => sub {$self->destroy})->pack; ...