source: project/release/4/shell/tags/0.3/shell.scm @ 25810

Last change on this file since 25810 was 25810, checked in by felix winkelmann, 9 years ago

shell 0.3: added capture form

File size: 1.3 KB
Line 
1;;;; shell.scm
2
3
4(module shell (execute run run* shell shell shell-verbose command capture)
5
6(import scheme chicken)
7(use extras utils data-structures posix)
8
9
10(define shell-verbose (make-parameter #f))
11
12(define (command . cmds)
13  (apply
14   values
15   (map (lambda (cmd)
16          (string-intersperse (map ->string (flatten cmd))))
17        cmds)))
18
19(define (execute cmds #!key status verbose capture)
20  (let ((ss 
21         (map
22          (lambda (cmd)
23            (let ((cmd (command cmd)))
24              (when (or verbose (shell-verbose))
25                (printf "  ~A~%~!" cmd))
26              (let ((r (if capture
27                           (with-input-from-pipe cmd read-all)
28                           (system cmd))))
29                (cond ((or capture status) r)
30                      ((not (zero? r)) 
31                       (error 
32                        'execute
33                        "shell command failed with non-zero exit status"
34                        cmd r))))))
35          cmds)))
36    (if (or capture status) (apply values ss) (void))))
37
38(define-syntax run1
39  (syntax-rules ()
40    ((_ args cmds ...)
41     (apply execute `(cmds ...) args))))
42
43(define-syntax run
44  (syntax-rules ()
45    ((_ cmd ...) (run1 '() cmd ...))))
46
47(define-syntax run*
48  (syntax-rules ()
49    ((_ cmd ...) (run1 '(status: #t) cmd ...))))
50
51(define-syntax shell
52  (syntax-rules ()
53    ((_ cmd ...) 
54     (lambda args 
55       (run1 args cmd ...)))))
56
57(define-syntax capture
58  (syntax-rules ()
59    ((_ cmd ...) (run1 '(capture: #t) cmd ...))))
60
61
62)
Note: See TracBrowser for help on using the repository browser.