coLinux 上の Emacs の kill-ring の内容をWindowsのクリップボードと同期する by Perl

Emacs を Meadow をやめて coLinux 上のものを PuTTY 経由で使うようにしたんですが、Emacs で killing にいれたものを Windows でペーストしたい、と思ったときに Meadow ですんなりできたそれができずにちょっとストレスになってました。そんな折、

Great Job! こういうのを Hack っていうんでしょうなあ。しかし、Python ! ここはいっちょ Perl で。

まず Windows 側に立てるサーバーを実装する。

ActivePerl + ppm で POE と PoCo::Server::IKC がすんなり入ったのでこれを使う。
クリップボードへの登録は一方向の非同期メッセージングなので、IKC::ClientLite を使えば簡単かなと思い。
受け取ったテキストのクリップボードへの登録は Win32::Cilpboard で。

#!perl
use strict;
use warnings;
use Win32::Clipboard;
use POE qw/Session Component::IKC::Server Component::TSTP Sugar::Args/;

POE::Component::IKC::Server->spawn(
    port => 10080,
    ip   => '192.168.100.1',
    name => 'ClipBoardServer',
);

POE::Component::TSTP->create;

POE::Session->create(
    inline_states => {
        _start => \&setup_service,
        update => \&update,
    }
);

POE::Kernel->run;

exit(0);

sub setup_service {
    my $poe = sweet_args;
    $poe->heap->{clip} = Win32::Clipboard();
    $poe->kernel->alias_set('clipboard_server');
    $poe->kernel->call(
        IKC => publish => clipboard_server => [qw/update/],
    );
}

sub update {
    my $poe = sweet_args;
    $poe->heap->{clip}->Set($poe->args->[0]);
}

1;

これを適当なところに置いておいてコマンドプロンプトから起動する。(ところでこれ起動するとなんか割り込み効かないんだけどなんでジャロ。) 起動時に立ち上がるようにとかはまたあとで。

次に coLinux 側で起動するクライアント。

PoCo::IKC::ClientLite で post する
日本語が文字化けしないように Encode で処理。
端末の自動判定は Term::Encoding で自動判定。
Emacs との連携以外でも使えるように入力は <> で処理。

cbcopy という名前にします。

#!/usr/local/bin/perl
use strict;
use warnings;
use POE qw/Component::IKC::ClientLite/;
use Encode qw/from_to/;
use Term::Encoding qw/term_encoding/;

sub error ($) {
    my $message = shift;
    die sprintf(
        "[error] %s %s",
        $message,
        $POE::Component::IKC::ClientLite::error
    );
}

local $/;
my $text = <>;
$text or exit 0;
from_to($text, term_encoding, 'cp932');

my $remote = POE::Component::IKC::ClientLite::create_ikc_client(
    port    => 10080,
    ip      => '192.168.100.1',
    name    => sprintf("ClipBoardClient_%d", $$),
    timeout => 5,
);
error "Couldn't connect to the server" unless $remote;

$remote->post('clipboard_server/update' => $text)
    or error "Couldn't post to the server";

これで

% cat /etc/motd | cbcopy

とかすると、/etc/motd の内容が Windows のクリップボードに入るようになります。

で、最終目的の Emacs との連携の部分は id:odz さん作の #1 のものを拝借。cl-sync-command を cbcopy に変えただけ。

;; cbcopy
;; http://d.hatena.ne.jp/odz/20061125/1164433815
(defvar cl-sync-command "cbcopy"
  "*The command for clipboard sync")

(defun cl-sync (beg end)
  (interactive "r")
  (call-process-region beg end shell-file-name
   nil nil nil shell-command-switch cl-sync-command))

(defadvice copy-region-as-kill
  (before clipboard-sync (beg end) activate)
  (cl-sync beg end))

(defadvice kill-region
  (before clipboard-sync (beg end) activate)
  (cl-sync beg end))

うまく動きました。ヤッホイ。

ただ、多分 Perl の起動時間のせいで Emacs で killing になんか登録したときの動きがもっさり。ネットワークでブロックされないように POE 使ったのに意味ない。xml-rpc.el には非同期モードがあるみたいだしそれでやるのがやっぱりいいっぽいですね。サーバー側を PoCo::Server::XMLRPC にするように改造してみます。(Python 使えばいいのにｗ)

追記

XML-RPC 版のサーバ。

#!perl
use strict;
use warnings;
use POE qw/Session Component::Server::XMLRPC Component::TSTP Sugar::Args/;
use Win32::Clipboard;
use Encode qw/encode/;

POE::Component::TSTP->create;
POE::Component::Server::XMLRPC->new(alias => 'xmlrpc', port => 10080);
POE::Session->create (
    inline_states => {
        _start => sub {
            my $poe = sweet_args;
            $poe->heap->{clip} = Win32::Clipboard();
            $poe->kernel->alias_set("cbserver");
            $poe->kernel->post(xmlrpc => publish => cbserver => 'clipboard.set');
        },
        _shutdown => sub {
            my $poe = sweet_args;
            $poe->post(xmlrpc => rescind => cbserver => "clipboard.set" );
        },
        'clipboard.set' => sub {
            my $poe = sweet_args;
            my $rpc = $poe->args->[0];
            my $text = $rpc->params->[0] or return $rpc->return(0);
            $poe->heap->{clip}->Set(encode('cp932', $text));
            $rpc->return(1);
        },
    },
);

POE::Kernel->run;
exit 0;

実用的な速度になった。id:odz さん thanks!

# あとは *Messages* バッファに Reading [text/xml]... 137 bytes of 130 bytes (105%) とか出るのを止めるというのが TODO.

追記の追記

url.el のメッセージを消すには、

(setq url-show-status nil)

で OK