diff --git a/inferior-shell.asd b/inferior-shell.asd index a1abfc9ecc00d159d168477dfa7c11f4a573542e..fca23d8e9496e7975072798bd74d4e66680e654a 100644 --- a/inferior-shell.asd +++ b/inferior-shell.asd @@ -1,10 +1,9 @@ ;;; -*- Lisp -*- -#+sbcl (require :sb-posix) - (defsystem :inferior-shell :defsystem-depends-on (:asdf-condition-control) - :depends-on (:asdf :xcvb-driver :fare-utils :fare-matcher :fare-quasiquote-readtable :fare-mop :alexandria) + :depends-on (:asdf :xcvb-utils :fare-quasiquote-extras :fare-mop :alexandria + #+sbcl :sb-posix) :description "spawn local or remote processes and shell pipes" :components ((:file "pkgdcl") diff --git a/pkgdcl.lisp b/pkgdcl.lisp index 2118fea8db125cb8c9a9fc34cdf9accf336b218c..16d6fb669f0fee8ccd1ee54ec573e2382171a1ca 100644 --- a/pkgdcl.lisp +++ b/pkgdcl.lisp @@ -3,7 +3,7 @@ (in-package :cl) (defpackage :inferior-shell - (:use :cl :xcvb-utils :fare-matcher :named-readtables :fare-mop) + (:use :cl :xcvb-utils :optima :named-readtables :fare-mop) (:export #:run #:run/s #:run/ss #:run/lines #:simple-command-line-token #:token-string diff --git a/process-spec.lisp b/process-spec.lisp index c15e6aaddc5a267e8243d200c9eda2ad476db683..a17c403e7431f86b7467396ca2d1200cdffaa158 100644 --- a/process-spec.lisp +++ b/process-spec.lisp @@ -1,8 +1,8 @@ #+xcvb (module (:depends-on ("pkgdcl"))) (in-package :inferior-shell) -(in-readtable :fare-quasiquote) +(in-readtable :fare-quasiquote) (defclass process-spec (simple-print-object-mixin) ()) @@ -193,12 +193,12 @@ (make-sequence-instance progn-spec args)) (`(fork ,@args) (make-sequence-instance fork-spec args)) - (`(,* ,@*) + (`(,_ ,@_) (let ((c (make-instance 'command-parse))) (dolist (elem spec) (parse-command-spec-top-token c elem)) (command-parse-results c))) - (* + (_ (error "Invalid process spec ~S" spec))))) (deftype simple-command-line-token () '(or string pathname keyword symbol character integer)) @@ -206,20 +206,31 @@ (defun token-string (x) (with-safe-io-syntax () (typecase x + (null "") (character (format nil "-~A" x)) (keyword (format nil "--~(~A~)" x)) (symbol (string-downcase x)) (string x) (pathname (native-namestring (translate-logical-pathname x))) - (list (write-to-string x)) + (cons (with-output-to-string (s) (mapcar (curry 'write-token-component s) x))) (t (princ-to-string x))))) +(defun write-token-component (s x) + (typecase x + (null nil) + (character (write-char x s)) + (symbol (write-string (string-downcase x) s)) + (string (write-string x s)) + (pathname (write-string (native-namestring (translate-logical-pathname x)) s)) + (cons (mapcar (curry 'write-token-component s) x)) + (t (princ x s)))) + (defun parse-command-spec-top-token (c x) (labels ((r (x) (add-redirection c x)) (f (sym fd pn flags) - (r (make-file-redirection sym fd pn flags))) + (r (make-file-redirection sym fd (token-string pn) flags))) (fd (old new) (r (make-fd-redirection old new))) (cl (old) @@ -276,7 +287,7 @@ (`(>>&! ,pn) (c `(>>! 1 ,pn)) (c `(>& 2 1))) - (* + (_ (flush-argument c) (parse-command-spec-token c x) (flush-argument c))))) @@ -306,9 +317,9 @@ (`(quote ,@args) ;; quote (e (xcvb-driver:escape-command (parse-command-spec-tokens args)))) - (`(,(of-type simple-command-line-token) ,@*) ;; recurse + (`(,(typep simple-command-line-token) _) ;; recurse (map () #'p x)) - (* + (_ (error "Unrecognized command-spec token ~S" x))))) (p x))) diff --git a/run-sbcl.lisp b/run-sbcl.lisp index 63ec437d8f6d7ff447d2deb835083b92b0aa2a34..30174bed872ba43caeeb9ce72984205c0d2ac400 100644 --- a/run-sbcl.lisp +++ b/run-sbcl.lisp @@ -57,6 +57,6 @@ (let ((collected (mapcar #'collect-threads full-results))) (case output (:string (apply #'concatenate 'string collected)) - (:string/stripped (strcat collected)) + (:string/stripped (stripln (apply #'concatenate 'string collected))) (:lines (apply #'concatenate 'list collected)) (otherwise collected)))))))