Change output ports to track current column. This is needed to do

indentation right.

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index 3700159ff9e042e1e8de6a6a2699db4db8b65b22..2618a642f426b9fd030ee025a0b570da276b31b6 100644 (file)
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.16 2002/11/20 19:46:20 cph Exp $
+$Id: genio.scm,v 1.17 2002/12/09 05:40:41 cph Exp $
 
-Copyright (c) 1991-1999 Massachusetts Institute of Technology
+Copyright (c) 1991-1999, 2002 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -56,6 +56,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
           (OUTPUT-BLOCKING-MODE ,operation/output-blocking-mode)
           (OUTPUT-BUFFER-SIZE ,operation/output-buffer-size)
           (OUTPUT-CHANNEL ,operation/output-channel)
+          (OUTPUT-COLUMN ,operation/output-column)
           (OUTPUT-OPEN? ,operation/output-open?)
           (OUTPUT-TERMINAL-MODE ,operation/output-terminal-mode)
           (SET-OUTPUT-BLOCKING-MODE ,operation/set-output-blocking-mode)
@@ -232,9 +233,12 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
                                       string start end))
 
 (define (operation/fresh-line port)
-  (if (not (output-buffer/line-start? (port/output-buffer port)))
+  (if (not (fix:= 0 (output-buffer/column (port/output-buffer port))))
       (operation/write-char port #\newline)))
 
+(define (operation/output-column port)
+  (output-buffer/column (port/output-buffer port)))
+
 (define (operation/output-buffer-size port)
   (output-buffer/size (port/output-buffer port)))
 

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 824a538cbb22e4ed550b0251baf45769721f61f9..962d13846a520be568b1ddc4c25dfb7425ce8a6c 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.65 2002/11/20 19:46:20 cph Exp $
+$Id: io.scm,v 14.66 2002/12/09 05:40:04 cph Exp $
 
-Copyright (c) 1988-2001 Massachusetts Institute of Technology
+Copyright (c) 1988-2002 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -514,7 +514,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
   line-translation                     ; string that newline maps to
   logical-size
   closed?
-  line-start?)
+  column)
 
 (define (output-buffer-sizes translation buffer-size)
   (let ((logical-size
@@ -548,7 +548,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
                             translation
                             logical-size
                             #f
-                            #t)))))
+                            0)))))
 
 (define (output-buffer/close buffer associated-buffer)
   (output-buffer/drain-block buffer)
@@ -713,13 +713,26 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
                                 n-prev*
                                 (loop (fix:+ index 1)
                                       (fix:+ n-prev* 1))))))))))))
-    (if (fix:> n-written 0)
-       (set-output-buffer/line-start?!
-        buffer
-        (char=? #\newline
-                (string-ref string (fix:+ start (fix:- n-written 1))))))
+    (set-output-buffer/column!
+     buffer
+     (let* ((end (fix:+ start n-written))
+           (nl (substring-find-previous-char string start end #\newline)))
+       (if nl
+          (count-columns string (fix:+ nl 1) end 0)
+          (count-columns string start end (output-buffer/column buffer)))))
     n-written))
 \f
+(define (count-columns string start end column)
+  ;; This simple-minded algorithm works only for a limited subset of
+  ;; US-ASCII.  Doing a better job quickly gets very hairy.
+  (do ((start start (fix:+ start 1))
+       (column column
+              (fix:+ column
+                     (if (char=? #\tab (string-ref string start))
+                         (fix:- 8 (fix:remainder column 8))
+                         1))))
+      ((fix:= start end) column)))
+
 (define (output-buffer/drain buffer)
   (let ((string (output-buffer/string buffer))
        (position (output-buffer/position buffer)))

diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm
index 7b2ab093fd90770eb4381e2c01156db45373c476..24150f558aada41def1ebb426acb0661d8e95fd0 100644 (file)
--- a/v7/src/runtime/output.scm
+++ b/v7/src/runtime/output.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: output.scm,v 14.24 2002/11/20 19:46:21 cph Exp $
+$Id: output.scm,v 14.25 2002/12/09 05:40:26 cph Exp $
 
-Copyright (c) 1988-2001 Massachusetts Institute of Technology
+Copyright (c) 1988-2002 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -60,6 +60,11 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
   (let ((operation (port/operation port 'Y-SIZE)))
     (and operation
         (operation port))))
+
+(define (output-port/column port)
+  (let ((operation (port/operation port 'OUTPUT-COLUMN)))
+    (and operation
+        (operation port))))
 \f
 ;;;; Output Procedures
 

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 44349dfb3133dc2f918af7db930453a05cbecdca..bc4881becc572c50496155cac9de227cf53c9393 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.416 2002/12/07 21:37:07 cph Exp $
+$Id: runtime.pkg,v 14.417 2002/12/09 05:39:38 cph Exp $
 
 Copyright (c) 1988-2002 Massachusetts Institute of Technology
 
@@ -1898,6 +1898,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
          flush-output
          fresh-line
          newline
+         output-port/column
          output-port/discretionary-flush
          output-port/flush-output
          output-port/fresh-line
@@ -2546,8 +2547,8 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
          output-buffer/buffered-chars
          output-buffer/channel
          output-buffer/close
+         output-buffer/column
          output-buffer/drain-block
-         output-buffer/line-start?
          output-buffer/open?
          output-buffer/set-size
          output-buffer/size
@@ -2577,7 +2578,6 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
          output-buffer/buffered-chars
          output-buffer/channel
          output-buffer/drain-block
-         output-buffer/line-start?
          output-buffer/set-size
          output-buffer/size
          output-buffer/write-char-block