From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 25 Oct 2006 05:40:21 +0000 (+0000)
Subject: Change way that WITH-NOTIFICATION prints "refresh" line.
X-Git-Tag: 20090517-FFI~874
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=322f2779c560d53b60523ea52b401d4e3ae28453;p=mit-scheme.git

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

diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm
index 4bdc1be8a..99e36f384 100644
--- 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