1 files changed, 23 insertions(+), 8 deletions(-)

M chicken-lock.scm

@@ 36,9 36,9 @@
 ;; This program works by fetching eggs into a temporary directory, so network
 ;; access is required. If a `-command` flag is given, the remaining arguments
 ;; will be called with the temporary egg cache directory name as a single
-;; argument. In this case, output will be suppressed and the cache directory
-;; will not be removed automatically. This feature can be used to print the
-;; directory name, for example, or to hash the directory for use with Nix:
+;; argument. In this case, the cache directory will not be removed automatically
+;; flag, and. This feature can be used to print the directory name, for example,
+;; or to hash the directory for use with Nix:
 ;;
 ;;     $ chicken-lock r7rs -command nix hash path
 ;;     ... some output ...


@@ 61,16 61,22 @@
           (chicken format)
           (chicken gc)
           (chicken pathname)
+          (chicken port)
           (chicken pretty-print)
           (chicken process)
           (chicken process-context)
           (chicken string)))
 
 (define (usage status)
-  (printf "Usage: ~a [egg ...] [-command arg ...]" (pathname-file (program-name)))
+  (printf "Usage: ~a [egg ...] [-output file] [-command arg ...]" (pathname-file (program-name)))
   (print)
   (exit status))
 
+(define (output-file output)
+  (if (string=? output "-")
+      (current-output-port)
+      (open-output-file output)))
+
 (define (status-file? path)
   (equal? (pathname-file path) "STATUS"))
 


@@ 123,21 129,30 @@
     (values cache repo env)))
 
 (define (main)
-  (let ((eggs '())
+  (let ((output "-")
+        (eggs '())
         (command '()))
     (let loop ((args (command-line-arguments)))
       (cond ((null? args))
             ((member (car args) '("-h" "-help" "--help"))
              (usage 0))
+            ((and (member (car args) '("-o" "-output" "-output-file" "--output" "--output-file")))
+             (unless (pair? (cdr args)) (usage 1))
+             (set! output (cadr args))
+             (loop (cddr args)))
             ((member (car args) '("-c" "-command" "--command"))
              (set! command (cdr args)))
             (else
              (set! eggs (cons (car args) eggs))
              (loop (cdr args)))))
     (receive (cache repo env) (create-cache (reverse eggs))
-      (if (null? command)
-          (print-cached-eggs env)
-          (process-execute (car command) (append (cdr command) (list cache)))))))
+      (with-output-to-port
+       (output-file output)
+       (lambda ()
+         (print-cached-eggs env)
+         (flush-output)))
+      (unless (null? command)
+        (process-execute (car command) (append (cdr command) (list cache)))))))
 
 (cond-expand
   (compiling (main))