Network clipboard tool written in Factor

So lately I've been going back and forth between two machines, my Mac and my Windows box. Getting small chunks of text between the machines (stuff other than what goes in the git repository) is a bit inconvenient. So I cooked up a tool to synchronize their clipboards. It is very rough, but you can use it as follows:

• network-clipboard-tool - opens the tool, showing a list of remote hosts. Each host is a presentation.
• "foo" add-network-clipboard - adds a remote host to the host list.
• Clicking Clipboard Server in the window allows other machines to add this host to their network clipboard host list.
• Right-clicking on a host presentation and invoking Send Clipboard sends the current machine's clipboard to the remote host.
• Right-clicking on a host presentation and invoking Receive Clipboard sets the current machine's clipboard to that of the remote host.

Since bidirectional transfer is supported, only one of the two machines needs to have a server running, but for convenience I run it on both. This is what it looks like, after right-clicking on the second host in the list:

The code is reasonably compact while still demonstrating TCP/IP networking and a number of UI features, such as models, operations, presentations, and commands. It has several limitations:

• Only supports Windows and Mac, not X11, since on X11 the UI uses a different set of words for clipboard access.
• There's no graphical way of editing the host list
• Perhaps even better, support for something like Apple's ZeroConf
• There is no security, but if you use it on a private LAN there is no problem

The code is in the repository now, in extra/network-clipboard. To try it out, just grab the latest Factor and do

"network-clipboard" run

The program begins with the usual boilerplate:

! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.server io.sockets io strings parser byte-arrays
namespaces ui.clipboards ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.buttons ui.gadgets.tracks ui.gadgets ui.operations
ui.commands ui kernel splitting combinators continuations
sequences io.streams.duplex models ;
IN: network-clipboard

A utility word to slurp in the current stream. It differs from the contents word in the io vocabulary in that it operates on stdio and doesn't close it at the end:

: contents ( -- str )
    [ 1024 read dup ] [ ] [ drop ] unfold concat ;

Now we can implement a very simple network protocol for getting and setting clipboard contents:

: get-request
    clipboard get clipboard-contents write ;

: set-request
    contents clipboard get set-clipboard-contents ;

We use the with-server combinator, which sets up a simple multi-threaded accept loop with logging:

: clipboard-port 4444 ;

: clipboard-server ( -- )
    clipboard-port internet-server "clip-server" [
        readln {
            { "GET" [ get-request ] }
            { "SET" [ set-request ] }
        } case
    ] with-server ;

We declare that this word is an UI command which is nullary (does not operate on a target option) and wishes to display output in a listener:

\ clipboard-server H{
    { +nullary+ t }
    { +listener+ t }
} define-command

A combinator to make a network connection:

: with-client ( addrspec quot -- )
    >r <client> r> with-stream ; inline

A host type and a simple protocol where either a string or a host can answer its name:

TUPLE: host name ;

C: <host> host
    
M: string host-name ;

Sending the current clipboard to another host:

: send-text ( text host -- )
    clipboard-port <inet4> [ write ] with-client ;

: send-clipboard ( host -- )
    host-name
    "SET\n" clipboard get clipboard-contents append swap send-text ;

We define it as an UI operation on hosts:

[ host? ] \ send-clipboard H{ } define-operation

Requesting another host's clipboard:

: ask-text ( text host -- )
    clipboard-port <inet4>
    [ write flush contents ] with-client ;

: receive-clipboard ( host -- )
    host-name
    "GET\n" swap ask-text
    clipboard get set-clipboard-contents ;

[ host? ] \ receive-clipboard H{ } define-operation

Printing host presentations:

: hosts. ( seq -- )
    "Hosts:" print
    [ dup <host> write-object nl ] each ;

The UI tool class:

TUPLE: network-clipboard-tool ;

We define a command map for the toolbar, containing a single command:

\ network-clipboard-tool "toolbar" f {
    { f clipboard-server }
} define-command-map

The constructor creates a new network clipboard tool instance, adding a toolbar and a list of hosts there. It takes a model as an input:

: <network-clipboard-tool> ( model -- gadget )
    \ network-clipboard-tool construct-empty [
        toolbar,
        [ hosts. ] <pane-control> <scroller> 1 track,
    ] { 0 1 } build-track ;

Now, a global model containing clipboard hosts and words to maintain it:

SYMBOL: network-clipboards

{ } <model> network-clipboards set-global

: set-network-clipboards ( seq -- )
    network-clipboards get set-model ;

: add-network-clipboard ( host -- )
    network-clipboards get [ swap add ] change-model ;

The final word -- it opens a window containing a new instance of this tool, with the global hosts model:

: network-clipboard-tool ( -- )
    network-clipboards get
    <network-clipboard-tool> "Network clipboard" open-window ;