scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fixed bug in CREATE-TEMP-FILE wherein format-string tilde's weren't 

being quoted. Oops.
This commit is contained in:
olin-shivers 2001-06-02 17:45:25 +00:00
parent d13ddc3216
commit 00544d449c
1 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
scsh/scsh.scm
View File

@ -444,7 +444,8 @@
(close-fdes (open-fdes fname oflags #o600)) (close-fdes (open-fdes fname oflags #o600))
fname) fname)
(if (null? maybe-prefix) '() (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* (define *temp-file-template*
(make-fluid (string-append "/tmp/" (number->string (pid)) ".~a"))) (make-fluid (string-append "/tmp/" (number->string (pid)) ".~a")))
@ -463,6 +464,23 @@
(loop (+ i 1))))))))) (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). ;;; Roughly equivalent to (pipe).
;;; Returns two file ports [iport oport] open on a temp file. ;;; Returns two file ports [iport oport] open on a temp file.