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