From d2a25f5e048131500a1ec7ae1ff6a633fbe97163 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 9 Dec 2002 05:40:41 +0000 Subject: [PATCH] Change output ports to track current column. This is needed to do indentation right. --- v7/src/runtime/genio.scm | 10 +++++++--- v7/src/runtime/io.scm | 31 ++++++++++++++++++++++--------- v7/src/runtime/output.scm | 9 +++++++-- v7/src/runtime/runtime.pkg | 6 +++--- 4 files changed, 39 insertions(+), 17 deletions(-) diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm index 3700159ff..2618a642f 100644 --- 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 824a538cb..962d13846 100644 --- 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)) +(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 7b2ab093f..24150f558 100644 --- 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)))) ;;;; Output Procedures diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 44349dfb3..bc4881bec 100644 --- 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 -- 2.25.1