Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv19623
Modified Files:
scsh.scm
Log Message:
Fixed bug in CREATE-TEMP-FILE wherein format-string tilde's weren't
being quoted. Oops.
Index: scsh.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh.scm,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** scsh.scm 2001/04/09 07:59:17 1.13
--- scsh.scm 2001/06/02 17:45:25 1.14
***************
*** 445,449 ****
fname)
(if (null? maybe-prefix) '()
! (list (string-append (car maybe-prefix) ".~a"))))))
(define *temp-file-template*
--- 445,450 ----
fname)
(if (null? maybe-prefix) '()
! (list (string-append (constant-format-string (car maybe-prefix))
! ".~a"))))))
(define *temp-file-template*
***************
*** 463,466 ****
--- 464,484 ----
(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))
|