From c0eddf21e1d6a5bf9c47400f616848d95343689e Mon Sep 17 00:00:00 2001
From: root <root>
Date: Wed, 25 Jan 2006 15:28:08 +0000
Subject: [PATCH] *** empty log message ***

---
 Changes                   |   2 -
 src/perl/remote-clipboard | 114 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 114 insertions(+), 2 deletions(-)
 create mode 100644 src/perl/remote-clipboard

diff --git a/Changes b/Changes
index f9db3e5d..fa2e4d5b 100644
--- a/Changes
+++ b/Changes
@@ -7,9 +7,7 @@ TODO: harmonize --disable-options into position-dependent options.
 TODO: after requesting the selection and getting a timeout, no further requests will be sent.
 TODO: "slow" rendering mode for bidi and scripts
 TODO: read property sequence is broken with respect to utf-8 etc.
-TODO: rxvt -name urxvt-girly /// leave pixel droppings
 WISH: anyevent mouse notification / manage MotionMask better.
-WISH: OnTheSpot editing, or maybe switch to miiiiiiif. or maybe use perl and an overlay...
 WISH: just for fun, do shade and tint with XRender.
 WISH: http://www120.pair.com/mccarthy/nextstep/intro.htmld/Workspace.html is the correct nextstep look.
 DUMB: support tex fonts
diff --git a/src/perl/remote-clipboard b/src/perl/remote-clipboard
new file mode 100644
index 00000000..c73b7231
--- /dev/null
+++ b/src/perl/remote-clipboard
@@ -0,0 +1,114 @@
+#! perl
+
+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::EVENT_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::EVENT_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);
+            close $fh;
+            my $status = $? >> 8;
+            $self->msg ("selection fetched (status $status)");
+         }
+      });
+   }
+}
+
+sub on_start {
+   my ($self) = @_;
+
+   $self->{store_cmd} = $self->x_resource ("remote-selection.store")
+                        || "rsh ruth 'cat >/tmp/distributed-selection'";
+
+   $self->{fetch_cmd} = $self->x_resource ("remote-selection.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 })
+   };
+
+   ()
+}
+
+sub on_keyboard_command {
+   my ($self, $cmd) = @_;
+
+   if ($cmd eq "selection-pastebin:remote-pastebin") {
+      $self->upload_paste;
+   }
+
+   ()
+}
+
-- 
2.34.1