From e4e3b0fd3d9aabf14f9924b4bfc22e60ec42c27a Mon Sep 17 00:00:00 2001 From: olin-shivers Date: Sat, 2 Jun 2001 17:43:12 +0000 Subject: [PATCH] Fixed bug in CREATE-TEMP-FILE wherein format-string tilde's weren't being quoted. Oops. --- scsh/scsh.scm | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/scsh/scsh.scm b/scsh/scsh.scm index 08621a1..ebb5114 100644 --- a/scsh/scsh.scm +++ b/scsh/scsh.scm @@ -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.