Add FRESH-LINE operation.
authorChris Hanson <org/chris-hanson/cph>
Sun, 26 Oct 2008 23:30:38 +0000 (23:30 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sun, 26 Oct 2008 23:30:38 +0000 (23:30 +0000)
v7/src/edwin/bufout.scm

index 91883041de39e4cbb7c44e1f032fa4f09549776d..74d3d5d2268751a8200277a032622327b16faa42 100644 (file)
@@ -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)