source: project/release/4/shell/trunk/shell.scm @ 21770

Last change on this file since 21770 was 21770, checked in by felix winkelmann, 10 years ago

shell: command command, tagged 0.2

File size: 1.1 KB
Line 
1;;;; shell.scm
2
3
4(module shell (execute run run* shell shell shell-verbose command)
5
6(import scheme chicken)
7(use extras utils data-structures)
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)
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 (system cmd)))
27                (cond (status r)
28                      ((not (zero? r)) 
29                       (error 
30                        'execute
31                        "shell command failed with non-zero exit status"
32                        cmd r))))))
33          cmds)))
34    (if status (apply values ss) (void))))
35
36(define-syntax run1
37  (syntax-rules ()
38    ((_ args cmds ...)
39     (apply execute `(cmds ...) args))))
40
41(define-syntax run
42  (syntax-rules ()
43    ((_ cmd ...) (run1 '() cmd ...))))
44
45(define-syntax run*
46  (syntax-rules ()
47    ((_ cmd ...) (run1 (list status: #t) cmd ...))))
48
49(define-syntax shell
50  (syntax-rules ()
51    ((_ cmd ...) 
52     (lambda args 
53       (run1 args cmd ...)))))
54
55
56)
Note: See TracBrowser for help on using the repository browser.