Add command substitution semantics

* geesh/shell.scm (%subshell): New function factored out from 'subshell'.
(subshell): Use it.
(substitute-command): New public function.
* tests/shell.scm: Test it.
* .dir-locals.el: Indent it nicely.

.dir-locals.el

@@ -10,4 +10,5 @@
    (eval . (put 'call-with-backquoted-input-port 'scheme-indent-function 1))
    (eval . (put 'make-script 'scheme-indent-function 1))
    (eval . (put 'sh:subshell 'scheme-indent-function 1))
+   (eval . (put 'sh:substitute-command 'scheme-indent-function 1))
    (eval . (put 'sh:with-redirects 'scheme-indent-function 2)))))

geesh/shell.scm

@@ -2,10 +2,12 @@
   #:use-module (geesh built-ins)
   #:use-module (geesh environment)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 textual-ports)
   #:use-module (srfi srfi-26)
   #:export (sh:exec-let
             sh:exec
             sh:subshell
+            sh:substitute-command
             sh:with-redirects))
 
 ;;; Commentary:
@@ -152,12 +154,35 @@ filename used for the here-document contents."
         (for-each restore-saved-fdes! (reverse saved-fds))))))
 
 
-;;; Subshells.
+;;; Subshells and command substitution.
 
-(define (sh:subshell env thunk)
-  "Run @var{thunk} in a subshell environment."
+(define* (%subshell thunk)
+  "Run @var{thunk} in a new process and return the ID of the new
+process."
   (match (primitive-fork)
     (0 (thunk)
        (primitive-exit))
-    (pid (match-let (((pid . status) (waitpid pid)))
-           (set-var! env "?" (number->string (status:exit-val status)))))))
+    (pid pid)))
+
+(define (sh:subshell env thunk)
+  "Run @var{thunk} in a subshell environment."
+  (match-let* ((pid (%subshell thunk))
+               ((pid . status) (waitpid pid)))
+    (set-var! env "?" (number->string (status:exit-val status)))))
+
+(define (sh:substitute-command env thunk)
+  "Run @var{thunk} in a subshell environment and return its output as
+a string."
+  (match-let* (((sink . source) (pipe))
+               (thunk* (lambda ()
+                         (close-port sink)
+                         (let ((redirs `((< 0 "/dev/null")
+                                         (>& 1 ,(fileno source))
+                                         (> 2 "/dev/null"))))
+                           (sh:with-redirects env redirs thunk))))
+               (pid (%subshell thunk*)))
+    (close-port source)
+    (match-let ((result (string-trim-right (get-string-all sink) #\newline))
+                ((pid . status) (waitpid pid)))
+      (set-var! env "?" (number->string (status:exit-val status)))
+      result)))

tests/shell.scm

@@ -325,4 +325,90 @@
 ;; TODO: Test other means of manipulating the environment and exit
 ;; statuses.
 
+
+;;; Command substitutions.
+
+(test-equal "Substitutes output from built-in"
+  "foo"
+  (let ((env (make-environment '())))
+    (sh:substitute-command env
+      (lambda ()
+        (display "foo")))))
+
+(test-equal "Substitutions ignore standard error for built-ins"
+  "foo"
+  (let ((env (make-environment '())))
+    (sh:substitute-command env
+      (lambda ()
+        (display "foo")
+        (display "bar" (current-error-port))))))
+
+(test-equal "Substitutions have null standard input for built-ins"
+  ""
+  (let ((env (make-environment '())))
+    (sh:substitute-command env
+      (lambda ()
+        (display (get-string-all (current-input-port)))))))
+
+(test-equal "Substitutes output from external utilities"
+  "foo"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let ((utility (string-append directory "/utility"))
+           (env (make-environment '())))
+       (make-script utility
+         (display "foo"))
+       (sh:substitute-command env
+         (lambda ()
+           (sh:exec env utility)))))))
+
+(test-equal "Substitutions ignore standard error for external utilities"
+  "foo"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let ((utility (string-append directory "/utility"))
+           (env (make-environment '())))
+       (make-script utility
+         (display "foo")
+         (display "bar" (current-error-port)))
+       (sh:substitute-command env
+         (lambda ()
+           (sh:exec env utility)))))))
+
+(test-equal "Substitutions have null standard input for external utilities"
+  ""
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let ((utility (string-append directory "/utility"))
+           (env (make-environment '())))
+       (make-script utility
+         (use-modules (ice-9 textual-ports))
+         (display (get-string-all (current-input-port))))
+       (sh:substitute-command env
+         (lambda ()
+           (sh:exec env utility)))))))
+
+(test-equal "Trailing newlines are trimmed from substitutions"
+  "foo"
+  (let ((env (make-environment '())))
+    (sh:substitute-command env
+      (lambda ()
+        (display "foo")
+        (newline)))))
+
+(test-equal "Non-trailing newlines are preserved in substitutions"
+  "\nfoo\nbar"
+  (let ((env (make-environment '())))
+    (sh:substitute-command env
+      (lambda ()
+        (newline)
+        (display "foo")
+        (newline)
+        (display "bar")))))
+
+(test-equal "Empty substitutions produce empty strings"
+  ""
+  (let ((env (make-environment '())))
+    (sh:substitute-command env noop)))
+
 (test-end)