#!/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__