From: Chris Hanson Date: Fri, 21 Mar 2003 17:51:23 +0000 (+0000) Subject: Implement runtime side of "--batch-mode" option. X-Git-Tag: 20090517-FFI~1940 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a279f899b9a769405b65bb015591e05656184b92;p=mit-scheme.git Implement runtime side of "--batch-mode" option. --- diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm index 540a13016..dbea9fd7f 100644 --- a/v7/src/runtime/genio.scm +++ b/v7/src/runtime/genio.scm @@ -1,8 +1,9 @@ #| -*-Scheme-*- -$Id: genio.scm,v 1.18 2003/02/14 18:28:32 cph Exp $ +$Id: genio.scm,v 1.19 2003/03/21 17:50:58 cph Exp $ -Copyright (c) 1991-1999, 2002 Massachusetts Institute of Technology +Copyright 1991,1993,1995,1996,1999,2002 Massachusetts Institute of Technology +Copyright 2003 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -217,11 +218,14 @@ USA. (else 'RAW)))) (define (operation/set-input-terminal-mode port mode) - (case mode - ((COOKED) (terminal-cooked-input (operation/input-channel port))) - ((RAW) (terminal-raw-input (operation/input-channel port))) - ((#F) unspecific) - (else (error:wrong-type-datum mode "terminal mode")))) + (let ((channel (operation/input-channel port))) + (if (channel-type=terminal? channel) + (case mode + ((COOKED) (terminal-cooked-input channel)) + ((RAW) (terminal-raw-input channel)) + ((#F) unspecific) + (else (error:wrong-type-datum mode "terminal mode"))) + unspecific))) (define (operation/flush-output port) (output-buffer/drain-block (port/output-buffer port))) @@ -270,11 +274,14 @@ USA. (else 'RAW)))) (define (operation/set-output-terminal-mode port mode) - (case mode - ((COOKED) (terminal-cooked-output (operation/output-channel port))) - ((RAW) (terminal-raw-output (operation/output-channel port))) - ((#F) unspecific) - (else (error:wrong-type-datum mode "terminal mode")))) + (let ((channel (operation/output-channel port))) + (if (channel-type=terminal? channel) + (case mode + ((COOKED) (terminal-cooked-output (operation/output-channel port))) + ((RAW) (terminal-raw-output (operation/output-channel port))) + ((#F) unspecific) + (else (error:wrong-type-datum mode "terminal mode"))) + unspecific))) (define (operation/close port) (operation/close-input port) diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index 3204c3276..7bfa46944 100644 --- a/v7/src/runtime/rep.scm +++ b/v7/src/runtime/rep.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rep.scm,v 14.60 2003/03/07 20:41:23 cph Exp $ +$Id: rep.scm,v 14.61 2003/03/21 17:51:03 cph Exp $ Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology Copyright 1992,1993,1994,1998,1999,2001 Massachusetts Institute of Technology @@ -218,6 +218,17 @@ USA. (if cmdl (cmdl/level cmdl) 0))) + +(define (nearest-cmdl/batch-mode?) + (let ((cmdl *nearest-cmdl*)) + (if cmdl + (cmdl/batch-mode? cmdl) + #f))) + +(define (cmdl/batch-mode? cmdl) + (and (= (cmdl/level cmdl) 1) + (implemented-primitive-procedure? (ucode-primitive batch-mode? 0)) + ((ucode-primitive batch-mode? 0)))) ;;;; Operations diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index e831ba32d..23f58d1a9 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.439 2003/03/14 20:11:53 cph Exp $ +$Id: runtime.pkg,v 14.440 2003/03/21 17:51:09 cph Exp $ Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology @@ -2754,6 +2754,7 @@ USA. cmdl-message/null cmdl-message/strings cmdl/base + cmdl/batch-mode? cmdl/driver cmdl/level cmdl/operation @@ -2774,6 +2775,7 @@ USA. make-repl-history make-repl-message nearest-cmdl + nearest-cmdl/batch-mode? nearest-cmdl/level nearest-cmdl/port nearest-repl diff --git a/v7/src/runtime/savres.scm b/v7/src/runtime/savres.scm index f4b4c1cb2..65eee84c7 100644 --- a/v7/src/runtime/savres.scm +++ b/v7/src/runtime/savres.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: savres.scm,v 14.43 2003/02/14 18:28:33 cph Exp $ +$Id: savres.scm,v 14.44 2003/03/21 17:51:14 cph Exp $ Copyright 1988,1989,1990,1991,1992,1995 Massachusetts Institute of Technology Copyright 1998,1999,2000,2001,2002,2003 Massachusetts Institute of Technology @@ -70,7 +70,8 @@ USA. (set! world-identification identify) (abort->top-level (lambda (cmdl) - (identify-world (cmdl/port cmdl)) + (if (not (cmdl/batch-mode? cmdl)) + (identify-world (cmdl/port cmdl))) (event-distributor/invoke! event:after-restart)))) ((not identify) #t) diff --git a/v7/src/runtime/ttyio.scm b/v7/src/runtime/ttyio.scm index c82bf1c0c..7675fe2d2 100644 --- a/v7/src/runtime/ttyio.scm +++ b/v7/src/runtime/ttyio.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: ttyio.scm,v 1.14 2003/02/14 18:28:34 cph Exp $ +$Id: ttyio.scm,v 1.15 2003/03/21 17:51:19 cph Exp $ -Copyright (c) 1991-1999 Massachusetts Institute of Technology +Copyright 1991,1993,1996,1999,2003 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -131,13 +131,17 @@ USA. (let ((char (input-buffer/read-char (port/input-buffer port)))) (if (eof-object? char) (signal-end-of-input port)) - (if (and char (console-port-state/echo-input? (port/state port))) + (if (and char + (not (nearest-cmdl/batch-mode?)) + (console-port-state/echo-input? (port/state port))) (output-port/write-char port char)) char)) (define (signal-end-of-input port) - (fresh-line port) - (write-string "End of input stream reached" port) + (if (not (nearest-cmdl/batch-mode?)) + (begin + (fresh-line port) + (write-string "End of input stream reached" port))) (%exit)) (define (operation/read-finish port) diff --git a/v7/src/runtime/usrint.scm b/v7/src/runtime/usrint.scm index 435bb12c6..5a592d7c1 100644 --- a/v7/src/runtime/usrint.scm +++ b/v7/src/runtime/usrint.scm @@ -1,8 +1,9 @@ #| -*-Scheme-*- -$Id: usrint.scm,v 1.19 2003/02/14 18:28:34 cph Exp $ +$Id: usrint.scm,v 1.20 2003/03/21 17:51:23 cph Exp $ -Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology +Copyright 1991,1992,1993,1994,1995,2001 Massachusetts Institute of Technology +Copyright 2003 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -48,18 +49,19 @@ USA. (error:wrong-type-datum prompt "a string or standard prompt")))) (define (write-command-prompt port prompt level) - (port/with-output-terminal-mode port 'COOKED - (lambda () - (fresh-line port) - (newline port) - (if (and (pair? prompt) - (eq? 'STANDARD (car prompt))) - (begin - (write level port) - (write-string " " port) - (write-string (cdr prompt) port)) - (write-string prompt port)) - (flush-output port)))) + (if (not (nearest-cmdl/batch-mode?)) + (port/with-output-terminal-mode port 'COOKED + (lambda () + (fresh-line port) + (newline port) + (if (and (pair? prompt) + (eq? 'STANDARD (car prompt))) + (begin + (write level port) + (write-string " " port) + (write-string (cdr prompt) port)) + (write-string prompt port)) + (flush-output port))))) (define (prompt-for-command-expression prompt #!optional port) (let ((prompt (canonicalize-command-prompt prompt)) @@ -217,21 +219,22 @@ USA. (define (default/write-result port expression object hash-number) expression - (port/with-output-terminal-mode port 'COOKED - (lambda () - (fresh-line port) - (write-string ";" port) - (if (and write-result:undefined-value-is-special? - (undefined-value? object)) - (write-string "Unspecified return value" port) - (begin - (write-string "Value" port) - (if hash-number - (begin - (write-string " " port) - (write hash-number port))) - (write-string ": " port) - (write object port)))))) + (if (not (nearest-cmdl/batch-mode?)) + (port/with-output-terminal-mode port 'COOKED + (lambda () + (fresh-line port) + (write-string ";" port) + (if (and write-result:undefined-value-is-special? + (undefined-value? object)) + (write-string "Unspecified return value" port) + (begin + (write-string "Value" port) + (if hash-number + (begin + (write-string " " port) + (write hash-number port))) + (write-string ": " port) + (write object port))))))) (define write-result:undefined-value-is-special? true)