rxvt-unicode-cvs/remote-clipboard.pl

   1 #!perl
   2 use Fcntl ();
   3
   4 sub msg {
   5         my ($self, $msg) = @_;
   6         my $overlay = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0);
   7         $overlay->set (0, 0, $msg);
   8         $self->{msg} = urxvt::timer->new->after (2)->cb (sub { delete $self->{msg}; undef $overlay; });
   9 }
  10
  11 sub store {
  12         my ($self) = @_;
  13
  14         eval {
  15                 local %ENV = %{ $self->env };
  16                 if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) {
  17                         fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK;
  18                         $self->{iow} = urxvt::iow->new->fd (fileno $fh)->events (urxvt::EV_WRITE)->start->cb (sub {
  19                                 my $txt = $self->selection;
  20                                 my $len = syswrite $fh, $txt;
  21                                 delete $self->{iow};
  22                                 $self->msg ($len);
  23                         });
  24                 }
  25         }
  26 }
  27
  28 sub fetch {
  29         my ($self) = @_;
  30
  31         eval {
  32                 local %ENV = %{ $self->env };
  33                 if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) {
  34                         fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK;
  35                         $self->{iow} = urxvt::iow->new->fd (fileno $fh)->events (urxvt::EV_READ)->start->cb (sub {
  36                                 my $txt;
  37                                 my $len = sysread $fh, $txt, 8192;
  38                                 delete $self->{iow};
  39                                 $self->selection_clear;
  40                                 $self->selection ($txt);
  41                                 $self->selection_grab (urxvt::CurrentTime);
  42                                 $self->msg ($len);
  43                                 utf8::decode ($txt);
  44                                 $self->tt_write ($self->locale_encode ($txt));
  45                         });
  46                 }
  47         }
  48 }
  49
  50 sub on_start {
  51         my ($self) = @_;
  52
  53         $self->{store_cmd} = $self->x_resource ("remote-selection.store") || "cat >/tmp/distributed-selection";
  54         $self->{fetch_cmd} = $self->x_resource ("remote-selection.fetch") || "cat /tmp/distributed-selection";
  55
  56         ()
  57 }
  58
  59 sub on_user_command {
  60         my ($self, $cmd) = @_;
  61
  62         if ($cmd eq "clipboard:copy") {
  63                 $self->store;
  64         } elsif ($cmd eq "clipboard:paste") {
  65                 $self->fetch;
  66         }
  67
  68         ()
  69 }