#!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new; $mw->title("Listbox"); # For example purposes, we will use one word for each letter my @choices = qw/alpha beta charlie delta echo foxtrot golf hotel india juliet kilo lima motel nancy oscar papa quebec radio sierra tango uniform victor whiskey xray yankee zulu/; #Create the text box and insert the list of choices in to it my $lb = $mw->Scrolled("Listbox", -scrollbars => "osoe", -height => 20, -selectmode => "multiple") ->pack(-side => "left"); $lb->insert("end", sort @choices); my $m = $lb->Menu(-tearoff => 0,-title=>'None', -menuitems => [ [Button => "Delete", -command => \&do1], [Button => "Rename", -command => \&do2], ] ); $lb->bind("" => [ sub { $lb->focus; # focus on listbox widget my($w, $x, $y) = @_; $m->post($x, $y); }, Ev('X'), Ev('Y') ] ); $mw->Button(-text => "Exit", -command => sub{exit; })->pack(-side => "bottom"); $mw->Button(-text=>"View", -command => sub { foreach ($lb->curselection()) { print "$choices[$_]\n"; } })->pack(-side => "bottom"); MainLoop; # Popup menu actions. sub do1{ my @sels = $lb->curselection(); print "@sels\n"; @sels = map $choices[$_],@sels; print "action do1->@sels\n"; } sub do2{ my @sels = $lb->curselection(); print "@sels\n"; @sels = map $choices[$_],@sels; print "action do2->@sels\n"; }