deesler has asked for the wisdom of the Perl Monks concerning the following question:

Oh wise and honorable monks of Perl: I am new to the use of Perl/Tk, but have done a fair bit of GUI programming in my past.

I am looking for a composite widget which has a list of items on the left side, from which you may select one of them, and click a button (with an arrow pointing to the right) to move it into a list on the right side. Likewise, you can select from the right-hand list, then select a different button (with the arrow pointing to the left) to remove it from the list. For example, the left-hand list contains all of the employees of your company, and you want to select a subset of them to populate the right hand list, in order to invite them to a meeting.

Does such a thing exist as a widget in Perl/Tk ? Of course, one can build it up from its component parts, but if it already exists, well that would save me some time. Thanks in advance.

Replies are listed 'Best First'.
Re: Perhaps it already exists
by zentara (Cardinal) on Dec 24, 2008 at 19:57 UTC
    Your wish is my command....:-)

    Here is a nice way using the -listvariable array option. Clicking on an entry will send it to the opposite box. The arrays are nice because you can keep them sorted easily. You can probably combine the update and update1 subs by passing in the src and dst arrays, but this way is less complicated. 

    #!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = tkinit;

my @employs = ('A'..'Z');
my @active = ();

my $l1 = $mw->Scrolled('Listbox',
       -listvariable => \@employs,
       -scrollbars =>'osow')->pack( -side => 'left' );

my $l2 = $mw->Scrolled('Listbox',
        -listvariable => \@active,
       -scrollbars =>'osow')->pack( -side => 'left',-padx=>10 );

my $button = $mw->Button(-text=>'Print Active',
             -command => sub{ print "@active\n"}
             )->pack(-side=>'left');


$l1->bind( '<ButtonRelease-1>', sub { update( $_[0], $l2 ) } );
$l2->bind( '<ButtonRelease-1>', sub { update1( $_[0], $l1 ) } );

MainLoop;

sub update {
    my ( $src, $dst ) = @_;
    my $index = $src->curselection;
    if ($index) {
        my $value = $src->get($index);
#        print "$value\n";
       @employs = grep { $_ ne $value } @employs;
       push @active, $value;
       @employs = sort @employs;
       @active = sort @active;
    }
}

sub update1 {
    my ( $src, $dst ) = @_;
    my $index = $src->curselection;
    if ($index) {
        my $value = $src->get($index);
#        print "$value\n";
       @active = grep { $_ ne $value } @active;
       push @employs, $value;
       @employs = sort @employs;
       @active = sort @active;
    }
}

    [download]
    I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]
[d/l]
      Once again zentara, Thank you very much.
[reply]

Back to Seekers of Perl Wisdom