| 1 |
root |
1.1 |
#! perl |
| 2 |
|
|
|
| 3 |
root |
1.7 |
#: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 |
root |
1.6 |
|
| 6 |
root |
1.9 |
=head1 NAME |
| 7 |
|
|
|
| 8 |
|
|
remote-clipboard - manage a shared and possibly rmeote clipboard |
| 9 |
|
|
|
| 10 |
root |
1.10 |
=head1 DESCRIPTION |
| 11 |
root |
1.9 |
|
| 12 |
|
|
Somewhat of a misnomer, this extension adds two menu entries to the |
| 13 |
|
|
selection popup that allows one to run external commands to store the |
| 14 |
|
|
selection somewhere and fetch it again. |
| 15 |
|
|
|
| 16 |
|
|
We use it to implement a "distributed selection mechanism", which just |
| 17 |
|
|
means that one command uploads the file to a remote server, and another |
| 18 |
|
|
reads it. |
| 19 |
|
|
|
| 20 |
|
|
The commands can be set using the C<URxvt.remote-selection.store> and |
| 21 |
|
|
C<URxvt.remote-selection.fetch> resources. The first should read the |
| 22 |
|
|
selection to store from STDIN (always in UTF-8), the second should provide |
| 23 |
|
|
the selection data on STDOUT (also in UTF-8). |
| 24 |
|
|
|
| 25 |
|
|
The defaults (which are likely useless to you) use rsh and cat: |
| 26 |
|
|
|
| 27 |
|
|
URxvt.remote-selection.store: rsh ruth 'cat >/tmp/distributed-selection' |
| 28 |
|
|
URxvt.remote-selection.fetch: rsh ruth 'cat /tmp/distributed-selection' |
| 29 |
|
|
|
| 30 |
|
|
=cut |
| 31 |
|
|
|
| 32 |
root |
1.1 |
use Fcntl (); |
| 33 |
|
|
|
| 34 |
|
|
sub msg { |
| 35 |
|
|
my ($self, $msg) = @_; |
| 36 |
|
|
|
| 37 |
|
|
my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0); |
| 38 |
|
|
$ov->set (0, 0, $msg); |
| 39 |
|
|
|
| 40 |
|
|
$self->{msg} = |
| 41 |
|
|
urxvt::timer |
| 42 |
|
|
->new |
| 43 |
|
|
->after (5) |
| 44 |
|
|
->cb (sub { delete $self->{msg}; undef $ov; }); |
| 45 |
|
|
} |
| 46 |
|
|
|
| 47 |
|
|
sub wait_pipe { |
| 48 |
|
|
my ($self, $fh, $pid, $msg) = @_; |
| 49 |
|
|
|
| 50 |
|
|
$self->msg ("waiting for selection process to finish..."); |
| 51 |
|
|
|
| 52 |
|
|
my $wait_pipe; $wait_pipe = urxvt::pw->new->start ($pid)->cb (sub { |
| 53 |
|
|
my ($undef, $status) = @_; |
| 54 |
|
|
undef $wait_pipe; |
| 55 |
|
|
close $fh; |
| 56 |
|
|
$status >>= 8; |
| 57 |
|
|
$self->msg ("$msg (status $status)"); |
| 58 |
|
|
}); |
| 59 |
|
|
} |
| 60 |
|
|
|
| 61 |
|
|
sub store { |
| 62 |
|
|
my ($self) = @_; |
| 63 |
|
|
|
| 64 |
|
|
my $txt = $self->selection; |
| 65 |
|
|
|
| 66 |
|
|
local %ENV = %{ $self->env }; |
| 67 |
|
|
if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) { |
| 68 |
|
|
fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
| 69 |
|
|
$self->{iow} = urxvt::iow |
| 70 |
|
|
->new |
| 71 |
|
|
->fd (fileno $fh) |
| 72 |
root |
1.5 |
->events (urxvt::EV_WRITE) |
| 73 |
root |
1.1 |
->start |
| 74 |
|
|
->cb (sub { |
| 75 |
|
|
if (my $len = syswrite $fh, $txt) { |
| 76 |
|
|
substr $txt, 0, $len, ""; |
| 77 |
|
|
$self->msg ((length $txt) . " chars to go..."); |
| 78 |
|
|
} else { |
| 79 |
|
|
delete $self->{iow}; |
| 80 |
|
|
$self->wait_pipe ($fh, $pid, "selection stored"); |
| 81 |
|
|
} |
| 82 |
|
|
}); |
| 83 |
|
|
} |
| 84 |
|
|
} |
| 85 |
|
|
|
| 86 |
|
|
sub fetch { |
| 87 |
|
|
my ($self) = @_; |
| 88 |
|
|
|
| 89 |
|
|
my $txt; |
| 90 |
|
|
|
| 91 |
|
|
local %ENV = %{ $self->env }; |
| 92 |
|
|
if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) { |
| 93 |
|
|
fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
| 94 |
|
|
$self->{iow} = urxvt::iow |
| 95 |
|
|
->new |
| 96 |
|
|
->fd (fileno $fh) |
| 97 |
root |
1.5 |
->events (urxvt::EV_READ) |
| 98 |
root |
1.1 |
->start |
| 99 |
|
|
->cb (sub { |
| 100 |
|
|
if (my $len = sysread $fh, $txt, 8192, length $txt) { |
| 101 |
|
|
$self->msg ((length $txt) . " chars read..."); |
| 102 |
|
|
} else { |
| 103 |
|
|
delete $self->{iow}; |
| 104 |
|
|
$self->selection_clear; |
| 105 |
|
|
$self->selection ($txt); |
| 106 |
|
|
$self->selection_grab (urxvt::CurrentTime); |
| 107 |
root |
1.3 |
$self->msg ("selection fetched"); |
| 108 |
root |
1.1 |
} |
| 109 |
|
|
}); |
| 110 |
|
|
} |
| 111 |
|
|
} |
| 112 |
|
|
|
| 113 |
|
|
sub on_start { |
| 114 |
|
|
my ($self) = @_; |
| 115 |
|
|
|
| 116 |
root |
1.8 |
$self->{store_cmd} = $self->x_resource ("%.store") |
| 117 |
root |
1.1 |
|| "rsh ruth 'cat >/tmp/distributed-selection'"; |
| 118 |
|
|
|
| 119 |
root |
1.8 |
$self->{fetch_cmd} = $self->x_resource ("%.fetch") |
| 120 |
root |
1.1 |
|| "rsh ruth 'cat /tmp/distributed-selection'"; |
| 121 |
|
|
|
| 122 |
|
|
push @{ $self->{term}{selection_popup_hook} }, sub { |
| 123 |
|
|
("selection => remote" => sub { $self->store }) |
| 124 |
|
|
}; |
| 125 |
|
|
push @{ $self->{term}{selection_popup_hook} }, sub { |
| 126 |
|
|
("remote => selection" => sub { $self->fetch }) |
| 127 |
|
|
}; |
| 128 |
|
|
|
| 129 |
|
|
() |
| 130 |
|
|
} |
| 131 |
|
|
|
| 132 |
|
|
|
