From fe72076284de7d79d15549fb36499bd5ee0f4ee8 Mon Sep 17 00:00:00 2001
From: root <root>
Date: Sat, 17 May 2014 13:38:23 +0000
Subject: X_RESOURCE => RESOURCE

---
 src/perl/remote-clipboard | 132 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 132 insertions(+)
 create mode 100644 src/perl/remote-clipboard

(limited to 'src/perl/remote-clipboard')

diff --git a/src/perl/remote-clipboard b/src/perl/remote-clipboard
new file mode 100644
index 0000000..3f27c2c
--- /dev/null
+++ b/src/perl/remote-clipboard
@@ -0,0 +1,132 @@
+#! perl
+
+#:META:RESOURCE:%.store:string:the command used to store the selection
+#:META:RESOURCE:%.fetch:string:the command used to fetch the selection
+
+=head1 NAME
+
+remote-clipboard - manage a shared and possibly remote clipboard
+
+=head1 DESCRIPTION
+
+Somewhat of a misnomer, this extension adds two menu entries to the
+selection popup that allows one to run external commands to store the
+selection somewhere and fetch it again.
+
+We use it to implement a "distributed selection mechanism", which just
+means that one command uploads the file to a remote server, and another
+reads it.
+
+The commands can be set using the C<URxvt.remote-selection.store> and
+C<URxvt.remote-selection.fetch> resources. The first should read the
+selection to store from STDIN (always in UTF-8), the second should provide
+the selection data on STDOUT (also in UTF-8).
+
+The defaults (which are likely useless to you) use rsh and cat:
+
+   URxvt.remote-selection.store: rsh ruth 'cat >/tmp/distributed-selection'
+   URxvt.remote-selection.fetch: rsh ruth 'cat /tmp/distributed-selection'
+
+=cut
+
+use Fcntl ();
+
+sub msg {
+   my ($self, $msg) = @_;
+
+   my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0);
+   $ov->set (0, 0, $msg);
+
+   $self->{msg} =
+      urxvt::timer
+              ->new
+              ->after (5)
+              ->cb (sub { delete $self->{msg}; undef $ov; });
+}
+
+sub wait_pipe {
+   my ($self, $fh, $pid, $msg) = @_;
+
+   $self->msg ("waiting for selection process to finish...");
+
+   my $wait_pipe; $wait_pipe = urxvt::pw->new->start ($pid)->cb (sub {
+      my ($undef, $status) = @_;
+      undef $wait_pipe;
+      close $fh;
+      $status >>= 8;
+      $self->msg ("$msg (status $status)");
+   });
+}
+
+sub store {
+   my ($self) = @_;
+
+   my $txt = $self->selection;
+
+   local %ENV = %{ $self->env };
+   if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) {
+      fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK;
+      $self->{iow} = urxvt::iow
+                     ->new
+                     ->fd (fileno $fh)
+                     ->events (urxvt::EV_WRITE)
+                     ->start
+                     ->cb (sub {
+         if (my $len = syswrite $fh, $txt) {
+            substr $txt, 0, $len, "";
+            $self->msg ((length $txt) . " chars to go...");
+         } else {
+            delete $self->{iow};
+            $self->wait_pipe ($fh, $pid, "selection stored");
+         }
+      });
+   }
+}
+
+sub fetch {
+   my ($self) = @_;
+
+   my $txt;
+
+   local %ENV = %{ $self->env };
+   if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) {
+      fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK;
+      $self->{iow} = urxvt::iow
+                     ->new
+                     ->fd (fileno $fh)
+                     ->events (urxvt::EV_READ)
+                     ->start
+                     ->cb (sub {
+         if (my $len = sysread $fh, $txt, 8192, length $txt) {
+            $self->msg ((length $txt) . " chars read...");
+         } else {
+            delete $self->{iow};
+            $self->selection_clear;
+            $self->selection ($txt);
+            $self->selection_grab (urxvt::CurrentTime);
+            $self->msg ("selection fetched");
+         }
+      });
+   }
+}
+
+sub on_start {
+   my ($self) = @_;
+
+   $self->{store_cmd} = $self->x_resource ("%.store")
+                        || "rsh ruth 'cat >/tmp/distributed-selection'";
+
+   $self->{fetch_cmd} = $self->x_resource ("%.fetch")
+                        || "rsh ruth 'cat /tmp/distributed-selection'";
+
+   push @{ $self->{term}{selection_popup_hook} }, sub {
+      ("selection => remote" => sub { $self->store })
+   };
+   push @{ $self->{term}{selection_popup_hook} }, sub {
+      ("remote => selection" => sub { $self->fetch })
+   };
+
+   ()
+}
+
+
-- 
cgit v1.2.3