Implement new `fresh-line' operation.

diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm
index ea43542ea3e53d9967284760a7c0c9576519dbae..0923f89a046cbbcc317f5a497a356fbf1cf51aa0 100644 (file)
--- a/v7/src/runtime/output.scm
+++ b/v7/src/runtime/output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/output.scm,v 14.6 1990/06/20 20:29:39 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/output.scm,v 14.7 1990/09/13 23:08:23 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -54,6 +54,7 @@ MIT in each case. |#
                               (copier %output-port/copy)
                               (print-procedure output-port/unparse))
   state
+  start-of-line?
   (operation/write-char false read-only true)
   (operation/write-string false read-only true)
   (operation/flush-output false read-only true)
@@ -67,6 +68,7 @@ MIT in each case. |#
 (define (output-port/copy port state)
   (let ((result (%output-port/copy port)))
     (set-output-port/state! result state)
+    (set-output-port/start-of-line?! result false)
     result))
 
 (define (output-port/custom-operation port name)
@@ -76,9 +78,9 @@ MIT in each case. |#
 (define (output-port/operation port name)
   (or (output-port/custom-operation port name)
       (case name
-       ((WRITE-CHAR) (output-port/operation/write-char port))
-       ((WRITE-STRING) (output-port/operation/write-string port))
-       ((FLUSH-OUTPUT) (output-port/operation/flush-output port))
+       ((WRITE-CHAR) output-port/write-char)
+       ((WRITE-STRING) output-port/write-string)
+       ((FLUSH-OUTPUT) output-port/flush-output)
        (else false))))
 
 (define (make-output-port operations state)
@@ -99,7 +101,7 @@ MIT in each case. |#
             (operation 'WRITE-STRING default-operation/write-string))
            (flush-output
             (operation 'FLUSH-OUTPUT default-operation/flush-output)))
-       (%make-output-port state write-char write-string flush-output
+       (%make-output-port state false write-char write-string flush-output
                           operations
                           (append '(WRITE-CHAR WRITE-STRING FLUSH-OUTPUT)
                                   (map car operations)))))))
@@ -117,10 +119,23 @@ MIT in each case. |#
   false)
 \f
 (define (output-port/write-char port char)
+  (set-output-port/start-of-line?! port (char=? #\newline char))
   ((output-port/operation/write-char port) port char))
 
 (define (output-port/write-string port string)
-  ((output-port/operation/write-string port) port string))
+  (let ((length (string-length string)))
+    (if (positive? length)
+       (begin
+         (set-output-port/start-of-line?!
+          port
+          (char=? #\newline (string-ref string (-1+ length))))
+         ((output-port/operation/write-string port) port string)))))
+
+(define (output-port/fresh-line port)
+  (if (not (output-port/start-of-line? port))
+      (begin
+       (set-output-port/start-of-line?! port true)
+       ((output-port/operation/write-char port) port #\newline))))
 
 (define (output-port/flush-output port)
   ((output-port/operation/flush-output port) port))
@@ -176,6 +191,15 @@ MIT in each case. |#
     (output-port/flush-output port))
   unspecific)
 
+(define (fresh-line #!optional port)
+  (let ((port
+        (if (default-object? port)
+            (current-output-port)
+            (guarantee-output-port port))))
+    (output-port/fresh-line port)
+    (output-port/flush-output port))
+  unspecific)
+
 (define (write-char char #!optional port)
   (let ((port
         (if (default-object? port)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index b5919a802bc62bd048f4b66773669a2924d712fe..99198f1405363df289590f6180b4a8fde8554742 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.76 1990/09/13 22:31:38 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.77 1990/09/13 23:08:53 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -1166,17 +1166,16 @@ MIT in each case. |#
          close-output-port
          current-output-port
          display
+         fresh-line
          guarantee-output-port
          make-output-port
          newline
          output-port/copy
          output-port/custom-operation
          output-port/flush-output
+         output-port/fresh-line
          output-port/operation
          output-port/operation-names
-         output-port/operation/flush-output
-         output-port/operation/write-char
-         output-port/operation/write-string
          output-port/state
          output-port/write-char
          output-port/write-string

diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index 1040ab2f965cba28127b5fc3242f53d50ea833fc..3bae1e8b3e1b76269eef3b7190c503746c86f21e 100644 (file)
--- a/v7/src/runtime/unpars.scm
+++ b/v7/src/runtime/unpars.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.16 1990/09/11 20:45:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.17 1990/09/13 23:08:07 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -150,14 +150,11 @@ MIT in each case. |#
                           (unparser-state/unparser-table state)))
 
 (define (unparse-object/internal object port list-depth slashify? table)
-  (fluid-let
-      ((*output-port* port)
-       (*unparse-char-operation* (output-port/operation/write-char port))
-       (*unparse-string-operation* (output-port/operation/write-string port))
-       (*list-depth* list-depth)
-       (*slashify?* slashify?)
-       (*unparser-table* table)
-       (*dispatch-vector* (unparser-table/dispatch-vector table)))
+  (fluid-let ((*output-port* port)
+             (*list-depth* list-depth)
+             (*slashify?* slashify?)
+             (*unparser-table* table)
+             (*dispatch-vector* (unparser-table/dispatch-vector table)))
     (*unparse-object object)))
 
 (define-integrable (invoke-user-method method object)
@@ -180,14 +177,12 @@ MIT in each case. |#
 ;;;; Low Level Operations
 
 (define *output-port*)
-(define *unparse-char-operation*)
-(define *unparse-string-operation*)
 
 (define-integrable (*unparse-char char)
-  (*unparse-char-operation* *output-port* char))
+  (output-port/write-char *output-port* char))
 
 (define-integrable (*unparse-string string)
-  (*unparse-string-operation* *output-port* string))
+  (output-port/write-string *output-port* string))
 
 (define-integrable (*unparse-substring string start end)
   (*unparse-string (substring string start end)))

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 03490d361440bea1246b77bad6ff56697eee86bb..2e1345b49902760d275f48473ce460832617904b 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.76 1990/09/13 22:31:38 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.77 1990/09/13 23:08:53 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -1166,17 +1166,16 @@ MIT in each case. |#
          close-output-port
          current-output-port
          display
+         fresh-line
          guarantee-output-port
          make-output-port
          newline
          output-port/copy
          output-port/custom-operation
          output-port/flush-output
+         output-port/fresh-line
          output-port/operation
          output-port/operation-names
-         output-port/operation/flush-output
-         output-port/operation/write-char
-         output-port/operation/write-string
          output-port/state
          output-port/write-char
          output-port/write-string