1 |
#! perl |
2 |
|
3 |
#:META:RESOURCE:%.store:string:the command used to store the selection |
4 |
#:META:RESOURCE:%.fetch:string:the command used to fetch the selection |
5 |
|
6 |
=head1 NAME |
7 |
|
8 |
remote-clipboard - manage a shared and possibly remote clipboard |
9 |
|
10 |
=head1 DESCRIPTION |
11 |
|
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 |
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 |
->events (urxvt::EV_WRITE) |
73 |
->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 |
->events (urxvt::EV_READ) |
98 |
->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 |
$self->msg ("selection fetched"); |
108 |
} |
109 |
}); |
110 |
} |
111 |
} |
112 |
|
113 |
sub on_start { |
114 |
my ($self) = @_; |
115 |
|
116 |
$self->{store_cmd} = $self->x_resource ("%.store") |
117 |
|| "rsh ruth 'cat >/tmp/distributed-selection'"; |
118 |
|
119 |
$self->{fetch_cmd} = $self->x_resource ("%.fetch") |
120 |
|| "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 |
|