From: Taylor R. Campbell <net/mumble/campbell>
Date: Tue, 9 Sep 2008 18:30:21 +0000 (+0000)
Subject: Implement FLUSH-OUTPUT and DISCRETIONARY-FLUSH-OUTPUT operations for
X-Git-Tag: 20090517-FFI~162
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=29185c9e4067dd0c82504fa1a234e0be26075a83;p=mit-scheme.git

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 18cf9c67f..3c1d4f95c 100644
--- 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)))