in reply to
Re: Right-click Edit/Paste in TK Browse Entry
in thread Right-click Edit/Paste in TK Browse Entry
As this one seems to have stumped (or bored) the monks, here's my final optimal(?) solution, tested on Windows, OS-X and Linux for adding a right mouse popup "Edit" menu to Widgets like Tk::Entry and Tk::BrowseList which don't already have such a feature.
#!/usr/bin/perl -w
# Demo right mouse click activated cut and paste
# on Tk widgets that don't have it, like Tk::Entry.
#
use strict;
use warnings;
use Tk;
my ($txt1, $txt2);
MAIN:
{
Tk::CmdLine::SetArguments(qw(-geometry +410+300));
my $win = MainWindow->new(-title=>'Cut and Paste Demo');
my $frame = $win->Frame;
my $f1 = $frame->Entry(-textvariable=>\$txt1, -width=>64, );
my $f2 = $frame->Entry(-textvariable=>\$txt2, -width=>64, );
$f1->grid(-row=>1, -column=>1, -padx=>10, -pady=>10, );
$f2->grid(-row=>2, -column=>1, -padx=>10, -pady=>10, );
$frame->pack;
add_edit_popup($win, $f1);
MainLoop;
}
#
# Adds a right-click Edit popup menu to a widget.
#
sub add_edit_popup
{
my ($mw, $obj) = @_;
my $menu = $mw->Menu(-tearoff=>0, -menuitems=>[
[qw/command Cut/, -command=>['clipboardCut', $obj,]],
[qw/command Copy/, -command=>['clipboardCopy', $obj,]],
[qw/command Paste/, -command=>['clipboardPaste', $obj]],
'',
[command=>'Select All', -command=>[
sub { $_[0]->selectionRange(0, 'end'); }, $obj, ]],
[command=>'Unselect All', -command=>[
sub { $_[0]->selectionClear; }, $obj, ]],
]);
$obj->menu($menu);
$obj->bind('<3>', ['PostPopupMenu', Ev('X'), Ev('Y'), ]);
return $obj;
}
__END__
If anyone can improve it, or sees potential problems with it, I'd appreciate a post.