Work around bug in variable linking mechanism.
authorChris Hanson <org/chris-hanson/cph>
Sat, 2 Feb 2008 06:53:37 +0000 (06:53 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 2 Feb 2008 06:53:37 +0000 (06:53 +0000)
v7/src/runtime/runtime.pkg
v7/src/runtime/usrint.scm

index 65191b8eea97eb8919b28597d4abfed39db6e2aa..65677b2929df6210fe606214f54693ff85ab2fd8 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.640 2008/02/02 06:51:39 cph Exp $
+$Id: runtime.pkg,v 14.641 2008/02/02 06:53:36 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -4290,13 +4290,13 @@ USA.
   (files "usrint")
   (parent (runtime))
   (export ()
-         (write-notification-line with-notification)
          prompt-for-command-char
          prompt-for-command-expression
          prompt-for-confirmation
          prompt-for-evaluated-expression
          prompt-for-expression
-         with-notification)
+         with-notification
+         write-notification-line)
   (export (runtime rep)
          port/set-default-environment
          port/write-result)
index f6791da5556d41fdfa203b93c150b3e2c78bd29e..c8fea1ab8a6e25f56ae7dd3586d8082e2073b59d 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usrint.scm,v 1.30 2008/02/02 05:48:57 cph Exp $
+$Id: usrint.scm,v 1.31 2008/02/02 06:53:37 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -294,10 +294,7 @@ USA.
 
 (define (with-notification message #!optional thunk)
   (if (or (default-object? thunk) (not thunk))
-      (let ((port (notification-output-port)))
-       (fresh-line port)
-       (write-notification-prefix port)
-       (message (wrap-notification-port port)))
+      (write-notification-line message)
       (let ((done? #f)
            (n))
        (dynamic-wind
@@ -329,6 +326,12 @@ USA.
                 (set! n)
                 (write-string "done" port)
                 (newline port))))))))
+
+(define (write-notification-line message)
+  (let ((port (notification-output-port)))
+    (fresh-line port)
+    (write-notification-prefix port)
+    (message (wrap-notification-port port))))
 \f
 (define (wrap-notification-port port)
   (make-port wrapped-notification-port-type port))