Change way that WITH-NOTIFICATION prints "refresh" line.

diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm
index 4bdc1be8a1115ede7c64109d290022a90071e839..99e36f384c81655786d8f2ad16e7064d9525ab47 100644 (file)
--- a/v7/src/runtime/usrint.scm
+++ b/v7/src/runtime/usrint.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usrint.scm,v 1.23 2006/10/25 05:05:24 cph Exp $
+$Id: usrint.scm,v 1.24 2006/10/25 05:40:21 cph Exp $
 
 Copyright 1991,1992,1993,1994,1995,2001 Massachusetts Institute of Technology
 Copyright 2003,2005,2006 Massachusetts Institute of Technology
@@ -295,42 +295,40 @@ USA.
 
 (define (with-notification message thunk)
   (let ((port (notification-output-port)))
-    (let ((prefix
-          (lambda ()
-            (fresh-line port)
-            (write-string ";" port)
-            (do ((i 0 (+ i 1)))
-                ((not (< i *notification-depth*)))
-              (write-string "  " port))
-            (message port)
-            (write-string "... " port))))
-      (prefix)
-      (let ((n (output-port/bytes-written port)))
-       (let ((p
-              (call-with-current-continuation
-               (lambda (k)
-                 (bind-condition-handler (list condition-type:error)
-                     (lambda (condition)
-                       (k (cons #f condition)))
-                   (lambda ()
-                     (fluid-let ((*notification-depth*
-                                  (+ *notification-depth* 1)))
-                       (cons #t (thunk)))))))))
-         (if (if n
-                 (> (output-port/bytes-written port) n)
-                 (output-port/line-start? port))
-             (prefix))
-         (write-string (if (car p) "done" "ERROR") port)
-         (newline port)
-         (if (car p)
-             (cdr p)
-             (signal-condition (cdr p))))))))
+    (start-notification-line)
+    (message port)
+    (write-string "... " port)
+    (let ((n (output-port/bytes-written port)))
+      (let ((p
+            (call-with-current-continuation
+             (lambda (k)
+               (bind-condition-handler (list condition-type:error)
+                   (lambda (condition)
+                     (k (cons #f condition)))
+                 (lambda ()
+                   (fluid-let ((*notification-depth*
+                                (+ *notification-depth* 1)))
+                     (cons #t (thunk)))))))))
+       (if (if n
+               (> (output-port/bytes-written port) n)
+               (output-port/line-start? port))
+           (begin
+             (start-notification-line)
+             (write-string "... " port)))
+       (write-string (if (car p) "done" "ERROR") port)
+       (newline port)
+       (if (car p)
+           (cdr p)
+           (signal-condition (cdr p)))))))
 
 (define (write-notification-line message)
+  (start-notification-line)
+  (message (notification-output-port)))
+
+(define (start-notification-line)
   (let ((port (notification-output-port)))
     (fresh-line port)
     (write-string ";" port)
     (do ((i 0 (+ i 1)))
        ((not (< i *notification-depth*)))
-      (write-string "  " port))
-    (message port)))
\ No newline at end of file
+      (write-string "  " port))))
\ No newline at end of file