src/perl/remote-clipboard

   1 #! perl
   2
   3 use Fcntl ();
   4
   5 sub msg {
   6    my ($self, $msg) = @_;
   7
   8    my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0);
   9    $ov->set (0, 0, $msg);
  10
  11    $self->{msg} =
  12       urxvt::timer
  13               ->new
  14               ->after (5)
  15               ->cb (sub { delete $self->{msg}; undef $ov; });
  16 }
  17
  18 sub wait_pipe {
  19    my ($self, $fh, $pid, $msg) = @_;
  20
  21    $self->msg ("waiting for selection process to finish...");
  22
  23    my $wait_pipe; $wait_pipe = urxvt::pw->new->start ($pid)->cb (sub {
  24       my ($undef, $status) = @_;
  25       undef $wait_pipe;
  26       close $fh;
  27       $status >>= 8;
  28       $self->msg ("$msg (status $status)");
  29    });
  30 }
  31
  32 sub store {
  33    my ($self) = @_;
  34
  35    my $txt = $self->selection;
  36
  37    local %ENV = %{ $self->env };
  38    if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) {
  39       fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK;
  40       $self->{iow} = urxvt::iow
  41                      ->new
  42                      ->fd (fileno $fh)
  43                      ->events (urxvt::EV_WRITE)
  44                      ->start
  45                      ->cb (sub {
  46          if (my $len = syswrite $fh, $txt) {
  47             substr $txt, 0, $len, "";
  48             $self->msg ((length $txt) . " chars to go...");
  49          } else {
  50             delete $self->{iow};
  51             $self->wait_pipe ($fh, $pid, "selection stored");
  52          }
  53       });
  54    }
  55 }
  56
  57 sub fetch {
  58    my ($self) = @_;
  59
  60    my $txt;
  61
  62    local %ENV = %{ $self->env };
  63    if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) {
  64       fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK;
  65       $self->{iow} = urxvt::iow
  66                      ->new
  67                      ->fd (fileno $fh)
  68                      ->events (urxvt::EV_READ)
  69                      ->start
  70                      ->cb (sub {
  71          if (my $len = sysread $fh, $txt, 8192, length $txt) {
  72             $self->msg ((length $txt) . " chars read...");
  73          } else {
  74             delete $self->{iow};
  75             $self->selection_clear;
  76             $self->selection ($txt);
  77             $self->selection_grab (urxvt::CurrentTime);
  78             $self->msg ("selection fetched");
  79          }
  80       });
  81    }
  82 }
  83
  84 sub on_start {
  85    my ($self) = @_;
  86
  87    $self->{store_cmd} = $self->x_resource ("remote-selection.store")
  88                         || "rsh ruth 'cat >/tmp/distributed-selection'";
  89
  90    $self->{fetch_cmd} = $self->x_resource ("remote-selection.fetch")
  91                         || "rsh ruth 'cat /tmp/distributed-selection'";
  92
  93    push @{ $self->{term}{selection_popup_hook} }, sub {
  94       ("selection => remote" => sub { $self->store })
  95    };
  96    push @{ $self->{term}{selection_popup_hook} }, sub {
  97       ("remote => selection" => sub { $self->fetch })
  98    };
  99
 100    ()
 101 }
 102
 103