1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
#lang scheme/base
(require mzlib/process)
(provide more-help)
(define (more-help name top-line)
(lambda (help)
(printf "This is `~a', ~a.\nUsage: " name top-line)
(display (regexp-replace
#rx"\n where" help
"\n where an \"-\" input file specifies standard input\n and"))
(display "See \"plt/preprocessor/doc.txt\" for more details.\n")
(exit 0)))
(provide run)
(define (run preprocess run-cmd output files)
(let ([files (map (lambda (f) (if (equal? f "-") (current-input-port) f))
(if (null? files) '("-") files))]
[exit-code 0])
(define (do-run-subst f)
(set! exit-code (system/exit-code (regexp-replace
#rx"\\*" run-cmd (format "~s" f)))))
(cond
[(and run-cmd (not (regexp-match #rx"\\*" run-cmd)))
(when output
(error 'mzpp "cannot run a command with piped stdin when an ~a"
"output name is specified"))
(let ([p (process/ports (current-output-port) #f (current-error-port)
run-cmd)])
(parameterize ([current-output-port (list-ref p 1)])
(apply preprocess files))
(close-output-port (list-ref p 1))
((list-ref p 4) 'wait)
(set! exit-code ((list-ref p 4) 'exit-code)))]
[(and run-cmd (not (or (= 1 (length files)) output)))
(error 'mzpp "cannot run a command that expects a filename with ~a"
"multiple input files and no output name")]
[(and run-cmd (not output))
(let* ([file (car files)]
[temp (format "~a-mzpp-temporary" file)])
(when (file-exists? temp)
(error 'mzpp "~s already exists!" temp))
(dynamic-wind
(lambda () (rename-file-or-directory file temp))
(lambda ()
(with-output-to-file file (lambda () (preprocess temp)))
(do-run-subst file))
(lambda ()
(delete-file file)
(rename-file-or-directory temp file))))]
[output
(with-output-to-file output #:exists 'replace
(lambda () (apply preprocess files)))
(when run-cmd (do-run-subst output))]
[else (apply preprocess files)])
(exit exit-code)))
|
