Thanks a lot,

it works fine

Thanks,

Srikrishnan

Some further commentary. A Tk::Text may not be your best choice to display and / or manipulate simple lists. It is possible to use them, but probably not optimal. You should likely at least make it a ROText to prevent unwanted modification. One of the List widgets seem like it would be better suited though.

Avoid cluttering up your script with globals. For small programs it isn't a big deal but as your script grows it will get harder keep track of them all. I like to use a single global hash to hold all of my Tk widget references. It keeps them tidy, makes it obvious what they are and generally makes for easier maintenance. This is just a personal preference but has been born through hard experience.

Narrow the scope of your subroutines. A sub called openFile() shouldn't do anything but return a file name (or file handle) you really shouldn't be doing any widget creation or text manipulation or any thing else in there. It will make debugging much easier down the road. Trust me...

You probably should install and use perltidy. It can really help make your code more readable.

If you want to be able to rearrange the order of your list of files you can do it elegantly with drag and drop. Here's a minimal example loosely based on your script using everything I mentioned above. (I was bored :-)

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::DragDrop;
use Tk::DropSite;

my %tk;

$tk{lbfont} = '{Helvetica} 14';

my $trashcan = '
R0lGODlhFgAZAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAK
+AgAMAg
AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAA
+CAACCA
AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAG
+DAAIDA
AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQM
+AAQOAA
QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQC
+BgQEBg
QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQI
+CgQKCg
QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQO
+DgQAAA
gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgE
+BAgGBA
gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgK
+CAgMCA
gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgA
+DggCDg
gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwG
+AgwIAg
wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwM
+BgwOBg
wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwC
+DAwEDA
wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAP8ALAAAAA
+AWABkA
BwjUAP8JHEiwoMGDCBMeBMAQgMKCDaVIJAUgicWEDe0h2CRlEykp9w7cY2gQwD179v4hOM
+ByCwBS
LO9RLJgE5gEEKFGSIiWT1BYpDgm+BIAg5L2jO5NKDCrUI8uiR49u2pKEqdCQmzzuzOpx6U
+KY9liK
TMqx6tcD9o4e4Hkvq9eSYHmu3Snlo1m4aOUqLWt14Mu8IfdKuQsxbmC6fM/a04t4cF+Bfx
+cf/pgY
r+S5Hz8CXRjy8l6qj/8BQPtPLE9SWUEjrBpyJdKfmxUCkDh4MOGHuHPjDggAOw==
';

$tk{mw} = MainWindow->new;

$tk{buttonframe} = $tk{mw}->Frame->pack( -pady => 3 );

$tk{load} = $tk{buttonframe}->Button(
    -text    => 'Select (Multiple) Files',
    -command => sub { $tk{listbox}->insert( 'end', getFiles() ) },
)->grid( -row => 1, -column => 1 );

$tk{clear} = $tk{buttonframe}->Button(
    -text    => 'Clear All',
    -command => sub { $tk{listbox}->delete( 0, 'end' ) },
)->grid( -row => 1, -column => 2 );

$tk{trash} = $tk{buttonframe}->Label(
    -image => $tk{mw}->Photo(
        -format => 'gif',
        -data   => $trashcan,
    ),
)->grid( -row => 1, -column => 3 );

$tk{process} = $tk{buttonframe}->Button(
    -text    => 'Process Files',
    -command => sub { print join " + ", $tk{listbox}->get( 0, 'end' );
+ },
)->grid( -row => 1, -column => 4 );

$tk{lbframe} = $tk{mw}->Frame->pack(
    -expand => 1,
    -fill   => 'both',
    -anchor => 'nw'
);

$tk{listbox} = $tk{lbframe}->Scrolled(
    'Listbox',
    -selectmode => 'single',
    -scrollbars => 'ose',
    -font       => $tk{lbfont},
  )->pack(
    -expand => 1,
    -fill   => 'both',
    -padx   => 5,
    -pady   => 5,
  );

my $dnd_token = $tk{listbox}->DragDrop(
    -event        => '<B1-Motion>',
    -sitetypes    => [qw/Local/],
    -startcommand => \&DragStart,
);

$tk{listbox}->DropSite(
    -droptypes   => [qw/Local/],
    -dropcommand => [ \&Drop, $tk{listbox}, $dnd_token ],
);

MainLoop;

sub DragStart {
    my ($token) = @_;
    my $site    = $token->parent;
    my $e       = $site->XEvent;
    my $idx     = $site->index( '@' . $e->x . ',' . $e->y );
    if ( defined $idx ) {
        $token->configure( -text => $site->get($idx), -font => $tk{lbf
+ont} );
        $site->delete($idx);
        my ( $X, $Y ) = ( $e->X, $e->Y );
        $token->MoveToplevelWindow( $X, $Y );
        $token->raise;
        $token->deiconify;
        $token->FindSite( $X, $Y, $e );
    }
}

sub Drop {
    my ( $site, $token ) = @_;
    my $text    = $token->cget('-text');
    my $y       = $site->pointery - $site->rooty;
    my $nearest = $site->nearest($y);
    if ( defined $nearest ) {
        my @xy = $site->bbox($nearest);
        if ( @xy and $xy[1] + $xy[3] > $y ) {
            $site->insert( $nearest, $text );
        }
        else {
            $site->insert( 'end', $text );
        }
    }
}

sub getFiles {
    my @types =
      ( [ "3d Files", '.3d' ], [ "Excel Files", '.xls' ],
        [ "All files", '*' ] );
    my @files = $tk{mw}->getOpenFile(
        -filetypes        => \@types,
        -defaultextension => '.3d',
        -title            => 'Hold Down Ctrl Key To Select Multiple Fi
+les',
        -multiple         => 1,
    );
    return @files;
}
[download]

Hi,

Thanks for your great piece of work (really it is very useful for me, I am searching and researching for such a tool for very long time)

I dont have any great documentation of perl/Tk with me. So I tried from my own so far and got lot of frustration.

But your help is very great to me.

Thanks a lot,

srikrishnan

Hi thundergnat

Again I thanks you for your sample. From the sample you have given, i got a idea of using "Listbox" option for my requirement. Also I have tried that with success

Below I have pasted my final completed code, may be it would be useful for somebody

use strict;
use warnings;
use Tk;
use Tk::ROText;
use win32;
use Win32::FileOp;
use File::Find;
use Tk::LabFrame;
use Tk::LabEntry;

my @filename;
my $w;
my $TagType;
my $var;
my $fileList;

my $mw = new MainWindow;
$mw -> setPalette('#EEEEEE');
$mw->resizable('no', 'no');
$mw -> title("get File List");


my $frame = $mw -> Frame -> pack (-side => 'top', -fill => 'both', -ex
+pand => 1, -padx => '12', -pady => '12');
my $frame1 = $frame -> Frame -> pack (-side => 'left');
$frame1 -> Button (-text => 'Add Files...', -command => \&openFile, -b
+ackground => '#E9F0F7', -activebackground => '#B8C4E5') -> pack (-sid
+e => 'top', -padx => '0', -pady => '10', -anchor => 'e');

my $frame3a = $mw -> Frame () -> pack (-side => 'top', -fill => 'both'
+, -expand => 1, -padx => 12, -pady => '6');
my $frame3 = $frame3a -> LabFrame (-label => "Add Files, and then arra
+nge them in the order you want.", -font => 'Arial-Bold 11', -labelsid
+e => "acrosstop") -> pack (-anchor => 'w');

my $ins = $frame3 -> Scrolled("Listbox", -scrollbars => 'e', -width =>
+ '90', -background => 'white') -> pack(-side => 'top', -pady => '12',
+ -padx => '12', -fill => 'both', -expand => 1);

my $frame4 = $frame3 -> Frame () -> pack (-side => 'top', -fill => 'bo
+th', -expand => 1, -padx => '12');
my $frame5 = $frame4 -> Frame -> pack (-side => 'left');

my $frame6 = $frame4 -> Frame -> pack (-side => 'left');
$frame6 -> Button (-text => 'Move Up', -command => \&moveUP, -backgrou
+nd => '#E9F0F7', -activebackground => '#B8C4E5', -width => '11') -> p
+ack (-side => 'top', -padx => '6', -pady => '10', -anchor => 'w');
my $frame7 = $frame4 -> Frame -> pack (-side => 'left');
$frame7 -> Button (-text => 'Move Down', -command => \&moveDown, -back
+ground => '#E9F0F7', -activebackground => '#B8C4E5', -width => '11') 
+-> pack (-side => 'top', -padx => '0', -pady => '10', -anchor => 'w')
+;
my $frame8 = $frame4 -> Frame -> pack (-side => 'left');
$frame8 -> Button (-text => 'Remove', -command => \&removePages, -back
+ground => '#E9F0F7', -activebackground => '#B8C4E5', -width => '11') 
+-> pack (-side => 'top', -padx => '6', -pady => '10', -anchor => 'w')
+;

my $frame10 = $mw -> Frame -> pack (-side => 'bottom', -fill => 'both'
+, -expand => 1, -padx => '12');
my $frame11 = $frame10 -> Frame -> pack (-side => 'right');
$frame11 -> Button (-text => 'Cancel', -command => sub{$mw -> destroy;
+}, -background => '#E9F0F7', -activebackground => '#B8C4E5', -width =
+> '9') -> pack (-side => 'top', -pady => '10', -anchor => 'ne');
my $frame12 = $frame10 -> Frame -> pack (-side => 'right');
$frame12 -> Button (-text => 'Process', -command => \&process, -backgr
+ound => '#E9F0F7', -activebackground => '#B8C4E5', -width => '9') -> 
+pack (-side => 'top', -padx => '0', -padx => '6', -pady => '10', -anc
+hor => 'ne');

MainLoop;

sub openFile {
    my @types =
      ( [ "3d Files", '.3d' ],
        [ "All files", '*' ] );
    @filename = $mw->getOpenFile(
        -filetypes  => \@types,
        -defaultextension => '.3d',
        -title            => 'file to read',
        -multiple       => 1,
    );

    $mw->Unbusy;
    return 'Cancel' unless (@filename);
    foreach my $single(@filename) {
    $ins->insert( 'end', "$single" );
    }
}

sub gotoSave {
        my $ExtractedStream = $w->get("1.0", "end");
        print "$ExtractedStream";
}       

sub gotoClear {
        $ins -> delete ("1.0", "end");
}

sub moveUP {
        my @fileList = $ins->curselection();
        my $selIndex = $fileList[0];
        $selIndex = $selIndex-1;
        $fileList = $ins->get(@fileList);
        $ins->delete(@fileList);
        $ins -> insert($selIndex, $fileList);
        $ins->selectionSet($selIndex);

}

sub moveDown {
        my @fileList = $ins->curselection();
        my $selIndex = $fileList[0];
        $selIndex = $selIndex+1;
        $fileList = $ins->get(@fileList);
        $ins->delete(@fileList);
        $ins -> insert($selIndex, $fileList);
        $ins->selectionSet($selIndex);
        
}

sub removePages {
       my @fileList = $ins->curselection();
       $ins->delete(@fileList); 
}

sub process {
        my @colList = $ins -> get(0, 'end');
        my $count = 1;
        foreach my $single(@colList) {
        print "$count\. $single\n";
        $count++;
        }
}
[download]

I have learned the following new things from your code

1. gif as a data within perl script

2. -multiple file selection option in "getOpenFile"

3. DragDrop and DropSite modules

4. Different way of coding with Tk

Once again thanks for teaching me all these things from a discussion

Thanks

Srikrishnan R.