Implement FLUSH-OUTPUT and DISCRETIONARY-FLUSH-OUTPUT operations for

wrapped notification output ports.

diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm
index 18cf9c67f17ee29adb35aac99677145b801f35af..3c1d4f95c752a71a005d7dfb7bce2488505fd4a9 100644 (file)
--- a/v7/src/runtime/usrint.scm
+++ b/v7/src/runtime/usrint.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usrint.scm,v 1.32 2008/02/02 17:59:59 cph Exp $
+$Id: usrint.scm,v 1.33 2008/09/09 18:30:21 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -336,7 +336,10 @@ USA.
 (define (make-wrapped-notification-port-type)
   (make-port-type `((WRITE-CHAR ,operation/write-char)
                    (X-SIZE ,operation/x-size)
-                   (COLUMN ,operation/column))
+                   (COLUMN ,operation/column)
+                   (FLUSH-OUTPUT ,operation/flush-output)
+                   (DISCRETIONARY-FLUSH-OUTPUT
+                    ,operation/discretionary-flush-output))
                  #f))
 
 (define (operation/write-char port char)
@@ -364,6 +367,12 @@ USA.
                  (max (- n (notification-prefix-length))
                       0)))))))
 
+(define (operation/flush-output port)
+  (output-port/flush-output (port/state port)))
+
+(define (operation/discretionary-flush-output port)
+  (output-port/discretionary-flush (port/state port)))
+
 (define (write-notification-prefix port)
   (write-string ";" port)
   (do ((i 0 (+ i 1)))