1 | #! perl |
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 | =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 |
2 | |
31 | |
3 | use Fcntl (); |
32 | use Fcntl (); |
4 | |
33 | |
5 | sub msg { |
34 | sub msg { |
6 | my ($self, $msg) = @_; |
35 | my ($self, $msg) = @_; |
… | |
… | |
38 | if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) { |
67 | if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) { |
39 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
68 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
40 | $self->{iow} = urxvt::iow |
69 | $self->{iow} = urxvt::iow |
41 | ->new |
70 | ->new |
42 | ->fd (fileno $fh) |
71 | ->fd (fileno $fh) |
43 | ->events (urxvt::EVENT_WRITE) |
72 | ->events (urxvt::EV_WRITE) |
44 | ->start |
73 | ->start |
45 | ->cb (sub { |
74 | ->cb (sub { |
46 | if (my $len = syswrite $fh, $txt) { |
75 | if (my $len = syswrite $fh, $txt) { |
47 | substr $txt, 0, $len, ""; |
76 | substr $txt, 0, $len, ""; |
48 | $self->msg ((length $txt) . " chars to go..."); |
77 | $self->msg ((length $txt) . " chars to go..."); |
… | |
… | |
63 | if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) { |
92 | if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) { |
64 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
93 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
65 | $self->{iow} = urxvt::iow |
94 | $self->{iow} = urxvt::iow |
66 | ->new |
95 | ->new |
67 | ->fd (fileno $fh) |
96 | ->fd (fileno $fh) |
68 | ->events (urxvt::EVENT_READ) |
97 | ->events (urxvt::EV_READ) |
69 | ->start |
98 | ->start |
70 | ->cb (sub { |
99 | ->cb (sub { |
71 | if (my $len = sysread $fh, $txt, 8192, length $txt) { |
100 | if (my $len = sysread $fh, $txt, 8192, length $txt) { |
72 | $self->msg ((length $txt) . " chars read..."); |
101 | $self->msg ((length $txt) . " chars read..."); |
73 | } else { |
102 | } else { |
… | |
… | |
82 | } |
111 | } |
83 | |
112 | |
84 | sub on_start { |
113 | sub on_start { |
85 | my ($self) = @_; |
114 | my ($self) = @_; |
86 | |
115 | |
87 | $self->{store_cmd} = $self->x_resource ("remote-selection.store") |
116 | $self->{store_cmd} = $self->x_resource ("%.store") |
88 | || "rsh ruth 'cat >/tmp/distributed-selection'"; |
117 | || "rsh ruth 'cat >/tmp/distributed-selection'"; |
89 | |
118 | |
90 | $self->{fetch_cmd} = $self->x_resource ("remote-selection.fetch") |
119 | $self->{fetch_cmd} = $self->x_resource ("%.fetch") |
91 | || "rsh ruth 'cat /tmp/distributed-selection'"; |
120 | || "rsh ruth 'cat /tmp/distributed-selection'"; |
92 | |
121 | |
93 | push @{ $self->{term}{selection_popup_hook} }, sub { |
122 | push @{ $self->{term}{selection_popup_hook} }, sub { |
94 | ("selection => remote" => sub { $self->store }) |
123 | ("selection => remote" => sub { $self->store }) |
95 | }; |
124 | }; |
… | |
… | |
98 | }; |
127 | }; |
99 | |
128 | |
100 | () |
129 | () |
101 | } |
130 | } |
102 | |
131 | |
103 | sub on_user_command { |
|
|
104 | my ($self, $cmd) = @_; |
|
|
105 | |
132 | |
106 | if ($cmd eq "selection-pastebin:remote-pastebin") { |
|
|
107 | $self->upload_paste; |
|
|
108 | } |
|
|
109 | |
|
|
110 | () |
|
|
111 | } |
|
|
112 | |
|
|