Fixed bug in CREATE-TEMP-FILE wherein format-string tilde's weren't
being quoted. Oops.
This commit is contained in:
parent
1602f0d114
commit
e4e3b0fd3d
|
@ -297,7 +297,8 @@
|
|||
(close-fdes (open-fdes fname oflags #o600))
|
||||
fname)
|
||||
(if (null? maybe-prefix) '()
|
||||
(list (string-append (car maybe-prefix) ".~a"))))))
|
||||
(list (string-append (constant-format-string (car maybe-prefix))
|
||||
".~a"))))))
|
||||
|
||||
(define *temp-file-template*
|
||||
(make-fluid (string-append "/usr/tmp/" (number->string (pid)) ".~a")))
|
||||
|
@ -316,6 +317,23 @@
|
|||
(loop (+ i 1)))))))))
|
||||
|
||||
|
||||
;; Double tildes in S.
|
||||
;; Using the return value as a format string will output exactly S.
|
||||
(define (constant-format-string s) ; Ugly code. Would be much clearer
|
||||
(let* ((len (string-length s)) ; if written with string SRFI.
|
||||
(tilde? (lambda (s i) (char=? #\~ (string-ref s i))))
|
||||
(newlen (do ((i (- len 1) (- i 1))
|
||||
(ans 0 (+ ans (if (tilde? s i) 2 1))))
|
||||
((< i 0) ans)))
|
||||
(fs (make-string newlen)))
|
||||
(let lp ((i 0) (j 0))
|
||||
(cond ((< i len)
|
||||
(let ((j (cond ((tilde? s i) (string-set! fs j #\~) (+ j 1))
|
||||
(else j))))
|
||||
(string-set! fs j (string-ref s i))
|
||||
(lp (+ i 1) (+ j 1))))))
|
||||
fs))
|
||||
|
||||
|
||||
;;; Roughly equivalent to (pipe).
|
||||
;;; Returns two file ports [iport oport] open on a temp file.
|
||||
|
|
Loading…
Reference in New Issue