O'Reilly logo

Mastering Perl/Tk by Nancy Walsh, Stephen Lidie

Stay ahead with the world's most comprehensive technology and business learning platform.

With Safari, you learn the way you learn best. Get unlimited access to videos, live online training, learning paths, books, tutorials, and more.

Start Free Trial

No credit card required

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.

Tk::MacCopy, shown with the CollapsableFrame both hidden and viewable

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; ...

With Safari, you learn the way you learn best. Get unlimited access to videos, live online training, learning paths, books, interactive tutorials, and more.

Start Free Trial

No credit card required