From 1f353d02981326518c060e42f493714cb04c9954 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 13 Sep 1990 23:08:53 +0000 Subject: [PATCH] Implement new `fresh-line' operation. --- v7/src/runtime/output.scm | 36 ++++++++++++++++++++++++++++++------ v7/src/runtime/runtime.pkg | 7 +++---- v7/src/runtime/unpars.scm | 21 ++++++++------------- v8/src/runtime/runtime.pkg | 7 +++---- 4 files changed, 44 insertions(+), 27 deletions(-) diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm index ea43542ea..0923f89a0 100644 --- 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) (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 b5919a802..99198f140 100644 --- 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 1040ab2f9..3bae1e8b3 100644 --- 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 03490d361..2e1345b49 100644 --- 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 -- 2.25.1