| 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 |
| 2 | |
5 | |
| 3 | use Fcntl (); |
6 | use Fcntl (); |
| 4 | |
7 | |
| 5 | sub msg { |
8 | sub msg { |
| 6 | my ($self, $msg) = @_; |
9 | my ($self, $msg) = @_; |
| … | |
… | |
| 38 | if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) { |
41 | if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) { |
| 39 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
42 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
| 40 | $self->{iow} = urxvt::iow |
43 | $self->{iow} = urxvt::iow |
| 41 | ->new |
44 | ->new |
| 42 | ->fd (fileno $fh) |
45 | ->fd (fileno $fh) |
| 43 | ->events (urxvt::EVENT_WRITE) |
46 | ->events (urxvt::EV_WRITE) |
| 44 | ->start |
47 | ->start |
| 45 | ->cb (sub { |
48 | ->cb (sub { |
| 46 | if (my $len = syswrite $fh, $txt) { |
49 | if (my $len = syswrite $fh, $txt) { |
| 47 | substr $txt, 0, $len, ""; |
50 | substr $txt, 0, $len, ""; |
| 48 | $self->msg ((length $txt) . " chars to go..."); |
51 | $self->msg ((length $txt) . " chars to go..."); |
| … | |
… | |
| 63 | if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) { |
66 | if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) { |
| 64 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
67 | fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; |
| 65 | $self->{iow} = urxvt::iow |
68 | $self->{iow} = urxvt::iow |
| 66 | ->new |
69 | ->new |
| 67 | ->fd (fileno $fh) |
70 | ->fd (fileno $fh) |
| 68 | ->events (urxvt::EVENT_READ) |
71 | ->events (urxvt::EV_READ) |
| 69 | ->start |
72 | ->start |
| 70 | ->cb (sub { |
73 | ->cb (sub { |
| 71 | if (my $len = sysread $fh, $txt, 8192, length $txt) { |
74 | if (my $len = sysread $fh, $txt, 8192, length $txt) { |
| 72 | $self->msg ((length $txt) . " chars read..."); |
75 | $self->msg ((length $txt) . " chars read..."); |
| 73 | } else { |
76 | } else { |
| 74 | delete $self->{iow}; |
77 | delete $self->{iow}; |
| 75 | $self->selection_clear; |
78 | $self->selection_clear; |
| 76 | $self->selection ($txt); |
79 | $self->selection ($txt); |
| 77 | $self->selection_grab (urxvt::CurrentTime); |
80 | $self->selection_grab (urxvt::CurrentTime); |
| 78 | close $fh; |
|
|
| 79 | my $status = $? >> 8; |
|
|
| 80 | $self->msg ("selection fetched (status $status)"); |
81 | $self->msg ("selection fetched"); |
| 81 | } |
82 | } |
| 82 | }); |
83 | }); |
| 83 | } |
84 | } |
| 84 | } |
85 | } |
| 85 | |
86 | |
| 86 | sub on_start { |
87 | sub on_start { |
| 87 | my ($self) = @_; |
88 | my ($self) = @_; |
| 88 | |
89 | |
| 89 | $self->{store_cmd} = $self->x_resource ("remote-selection.store") |
90 | $self->{store_cmd} = $self->x_resource ("%.store") |
| 90 | || "rsh ruth 'cat >/tmp/distributed-selection'"; |
91 | || "rsh ruth 'cat >/tmp/distributed-selection'"; |
| 91 | |
92 | |
| 92 | $self->{fetch_cmd} = $self->x_resource ("remote-selection.fetch") |
93 | $self->{fetch_cmd} = $self->x_resource ("%.fetch") |
| 93 | || "rsh ruth 'cat /tmp/distributed-selection'"; |
94 | || "rsh ruth 'cat /tmp/distributed-selection'"; |
| 94 | |
95 | |
| 95 | push @{ $self->{term}{selection_popup_hook} }, sub { |
96 | push @{ $self->{term}{selection_popup_hook} }, sub { |
| 96 | ("selection => remote" => sub { $self->store }) |
97 | ("selection => remote" => sub { $self->store }) |
| 97 | }; |
98 | }; |
| … | |
… | |
| 100 | }; |
101 | }; |
| 101 | |
102 | |
| 102 | () |
103 | () |
| 103 | } |
104 | } |
| 104 | |
105 | |
| 105 | sub on_keyboard_command { |
|
|
| 106 | my ($self, $cmd) = @_; |
|
|
| 107 | |
106 | |
| 108 | if ($cmd eq "selection-pastebin:remote-pastebin") { |
|
|
| 109 | $self->upload_paste; |
|
|
| 110 | } |
|
|
| 111 | |
|
|
| 112 | () |
|
|
| 113 | } |
|
|
| 114 | |
|
|
