(in-package :cl-user)

(defparameter *remote-machine* "amethyst.local")
(defparameter *remote-lisp-command* "/Users/gilbert/bin/clim")

;; Very simple application to sync clipboards between two machines.

(defun set-clipboard (string)
  (progn ;;when (> (length string) 0)
    (ccl::with-cfstring (s string)
      (let* ((pb (#/generalPasteboard ns:ns-pasteboard)))
        (#/declareTypes:owner: pb (#/arrayWithObject: ns:ns-array #&NSStringPboardType) nil)
        (#/setString:forType: pb s #&NSStringPboardType)))))

(defun get-clipboard ()
  (let* ((pb (#/generalPasteboard ns:ns-pasteboard)))
    (let ((s (#/stringForType: pb #&NSStringPboardType)))
      (values
       (and (not (ccl:%null-ptr-p s))
            (ccl::%get-cfstring s))
       (#/types pb)))))

(defun clipboard-loop (input output &optional (debug nil))
  (let (old
        (pb (#/generalPasteboard ns:ns-pasteboard)))
    (loop
      (let ((c (read-char-no-hang input nil :eof)))
        (when (eq c :eof) (return))
        (when c
          (when (not (member c '(#\newline #\space #\tab)))
            (unread-char c input)
            (let ((x (ignore-errors (read input))))
              (unless x (return))
              (unless (stringp x) (return))
              (when debug (format *trace-output*     ";; they ~S~%" x))
              (set-clipboard x))
            (setq old (#/changeCount pb))))
        (let ((count (#/changeCount pb)))
          (unless (eql count old)
            (setq old count)
            (let ((s (get-clipboard)))
              (when s
                (when debug (format *trace-output* ";; we   ~S~%" s))
                (prin1 s output)
                (terpri output)))
            (force-output output)))
        (sleep 1/10)))))

(defun slave-loop ()
  (clipboard-loop *standard-input* *standard-output*))

(defun master-loop ()
  (let ((proc (ccl:run-program
               "ssh"
               (list *remote-machine* *remote-lisp-command*)
               :external-format :utf-8
               :input :stream :output :stream
               :wait nil
               :error *error-output*)))
    (multiple-value-bind (input output)
        (values (ccl:external-process-output-stream proc)
                (ccl:external-process-input-stream proc))
      (unwind-protect
           (progn
             (with-open-file (input '#.(or *compile-file-truename* *load-truename*))
               (loop for x = (read-line input nil input)
                     until (eq x input)
                     do (write-line x output)))
             (prin1 `(progn (terpri) (write-line "OK") (force-output) (slave-loop)) output)
             (terpri output)
             (force-output output)
             (loop for x = (read-line input)
                   do (write-line x)
                   until (equal x "OK"))
             (clipboard-loop input output t))
        (close input)
        (close output)))))