From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 26 Oct 2008 23:30:38 +0000 (+0000)
Subject: Add FRESH-LINE operation.
X-Git-Tag: 20090517-FFI~94
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=114b9674c94b4facf535b42e452e6c14cc1ee8d8;p=mit-scheme.git

Add FRESH-LINE operation.
---

diff --git a/v7/src/edwin/bufout.scm b/v7/src/edwin/bufout.scm
index 91883041d..74d3d5d22 100644
--- a/v7/src/edwin/bufout.scm
+++ b/v7/src/edwin/bufout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: bufout.scm,v 1.21 2008/07/26 05:12:19 cph Exp $
+$Id: bufout.scm,v 1.22 2008/10/26 23:30:38 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -85,6 +85,13 @@ USA.
 	(fix:- end start))
       (generic-port-operation:write-substring port string start end)))
 
+(define (operation/line-start? port)
+  (line-start? (port/mark port)))
+
+(define (operation/fresh-line port)
+  (if (not (operation/line-start? port))
+      (region-insert-newline! (port/mark port))))
+
 (define (operation/close port)
   (mark-temporary! (port/mark port)))
 
@@ -94,6 +101,8 @@ USA.
 (define mark-output-port-type
   (make-port-type `((CLOSE ,operation/close)
 		    (FLUSH-OUTPUT ,operation/flush-output)
+		    (FRESH-LINE ,operation/fresh-line)
+		    (LINE-START? ,operation/line-start?)
 		    (WRITE-CHAR ,operation/write-char)
 		    (WRITE-SELF ,operation/write-self)
 		    (WRITE-SUBSTRING ,operation/write-substring)