add clipboard support for wsl

frontends/ncurses/clipboard.lisp

@@ -75,6 +75,21 @@
       (setf (unix-paste-command os) command)
       text)))
 
+;;;
+(defclass wsl (os)
+  ())
+
+(defmethod copy-aux ((os wsl) text)
+  (execute-copy '("clip.exe") text))
+
+(defmethod paste-aux ((os wsl))
+  (let ((text (execute-paste '("powershell.exe" "Get-Clipboard"))))
+    (setf text (ppcre:regex-replace-all "\\r" text ""))
+    (when (and (plusp (length text))
+               (char= #\newline (char text (1- (length text)))))
+      (setf text (subseq text 0 (1- (length text)))))
+    text))
+
 ;;;
 (defclass windows (os)
   ())
@@ -85,13 +100,15 @@
   (or #+darwin
       'mac
       #+unix
-      'unix
+      (if (lem::wsl-p) 'wsl 'unix)
       'windows))
 
-(let ((os nil))
-  (defun os ()
-    (or os
-        (setf os (make-instance (get-os-name))))))
+(defvar *os*)
+
+(defun os ()
+  (if (boundp '*os*)
+      *os*
+      (setf *os* (make-instance (get-os-name)))))
 
 (defun copy (text)
   (copy-aux (os) text)

src/clipboard.lisp

@@ -1,5 +1,8 @@
 (in-package :lem)
 
+(defun wsl-p ()
+  (zerop (nth-value 2 (uiop:run-program '("which" "clip.exe") :ignore-error-status t))))
+
 (defun sbcl-2.0.0-or-later-p ()
   (and (string-equal "sbcl" (lisp-implementation-type))
        (let ((version (mapcar #'parse-integer
@@ -12,7 +15,7 @@
 (defparameter *enable-clipboard-p*
   (ignore-errors
     #+darwin (sbcl-2.0.0-or-later-p)
-    #-darwin t))
+    #-darwin (not (wsl-p))))
 
 (defun enable-clipboard-p ()
   *enable-clipboard-p*)