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

I've searched and can find no obvious way to add the right-click popup Edit/cut and paste behavior of widgets like Tk::Entry to Tk::BrowseEntry. Control+c/v work fine, but a lot of my app users are addicted to that right mouse button (or their keyboard is too far away, or something...)

Anyone done this?

Later: Ok I've found out how to do this manually creating a popup menu at the click point and writing explicit code to use the clipboard for cut, paste, copy. I can add the functionality to individual Widgets (like Entry !!) which don't have it, an probably subclass so I'm not repeating the code on every widget (after some study). But surely this is a common enough thing to do that there's got to be a better way.

The following example (not my "real" code) is a running example with two Entry widgets. The first has the right-click Edit functions, the second does not, although it intrinsically responds to the ^C, ^V, ^X conventions in conjuration with the first field. The "add_edit_popup" has also been tested on Tk::BrowseEntry widgets successfully. 


#!/usr/bin/perl -w
#
# Demo cut and paste on 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;
}

sub add_edit_popup
{
  my ($mw, $obj) = @_;
  my $menu = $mw->Menu(-tearoff=>0, -menuitems=>[
    [qw/command Cut/, -command=>[\&cb_cut, $obj, 1]],
    [qw/command Copy/, -command=>[\&cb_cut, $obj, 0]],
    [qw/command Paste/, -command=>[\&cb_paste, $obj]],
    '',
    [command=>'Select All', -command=>[\&cb_sel_all, $obj]],
    [command=>'Unselect All', -command=>[\&cb_unsel_all, $obj]],
  ]);
  $obj->menu($menu);
  $obj->bind('<3>', [sub { my ($w, $x, $y) = @_; $menu->post($x, $y); 
+}, Ev('X'), Ev('Y'), ]);
}

sub cb_cut
{
  my ($widget, $clear, $txt) = @_;
  eval { $txt = $widget->SelectionGet(); };
  return if $@;
  if ($clear) {
    $widget->delete('sel.first', 'sel.last');
  }
  $widget->clipboardClear;
  $widget->clipboardAppend($txt);
}

sub cb_paste
{
  my ($widget) = @_;
  Tk::catch { $widget->Insert($widget->clipboardGet); }
}

sub cb_sel_all
{
  my ($widget) = @_;
  $widget->selectionRange(0, 'end');
}

sub cb_unsel_all
{
  my ($widget) = @_;
  $widget->selectionClear;
}

__END__

[download]

Replies are listed 'Best First'.
Re: Right-click Edit/Paste in TK Browse Entry
by ron7 (Beadle) on Mar 21, 2011 at 09:07 UTC
    Oops. There is bug in the above under Linux (but not MS windows and OS-X).

    If you don't select a popup menu item, the popup stays there--clicking elsewhere in the window does not close it. You can end up with dozens of them scattering the landscape.

    The only 'cure' I can find is store the menu which has been popped up in a global, and bind a left mouse down event to unpost the global (ignored by Windoze and OS-X which intrinsically remove popup menus). Probably should bind the Escape key to do the same.

    Ugly, ugly. There HAS to be a better way!! 

    my $oldmenu;
...
sub add_edit_popup
{
  ...
  $obj->bind('<3>', 
    [sub { my ($w, $x, $y) = @_; $menu->post($x, $y); 
           $oldmenu = $menu; }, Ev('X'), Ev('Y'), ]);
  $mw->bind('<ButtonPress-1>', 
    [sub { if ($oldmenu) { $oldmenu->unpost; } undef $oldmenu; } ]);
}

    [download]
[reply]
[d/l]
      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__

      [download]
      If anyone can improve it, or sees potential problems with it, I'd appreciate a post.
[reply]
[d/l]

        First, I'd like to thank you for this info! I've been using Perl for quite a while, but being self-taught means that sometimes I have to use "cookbook" code that I don't completely understand. On to my comment/question ...

        I tried using the "add_edit_popup" sub in my Tk app. It works great for Tk widgets that are in global scope. I pass into "add_edit_popup" my globally scoped MainWindow along with whatever globally scoped widgets, and it works like a charm!

        The problem is when I try to do the same with locally scoped Tk widgets that are in a sub. For example, I have a sub that withdraws the root MainWindow and creates a new MainWindow populated with widgets. When I make a call to "add_edit_popup" from within this sub (passing in the local MainWindow and Entry widgets), I get an error saying something along the lines of "can't call 'menu' without package or object reference".

        Is this something anyone can answer from what I've described? If not, I'm happy to cook up some sample code to reproduce this problem.

        First time poster but long time researcher here. Thanks so much for any help!

[reply]

Back to Seekers of Perl Wisdom