diff --git a/scheme/ikarus.io.output-files.ss b/scheme/ikarus.io.output-files.ss index 7d38f27..f8f1bcf 100644 --- a/scheme/ikarus.io.output-files.ss +++ b/scheme/ikarus.io.output-files.ss @@ -16,7 +16,7 @@ (library (ikarus io output-files) (export standard-output-port standard-error-port - console-output-port current-output-port + console-output-port current-output-port current-error-port open-output-file with-output-to-file call-with-output-file) (import (ikarus system $ports) @@ -28,11 +28,8 @@ (rnrs bytevectors) (except (ikarus) standard-output-port standard-error-port - console-output-port current-output-port - *standard-output-port* *standard-error-port* - *current-output-port* - open-output-file with-output-to-file - call-with-output-file)) + console-output-port current-output-port current-error-port + open-output-file with-output-to-file call-with-output-file)) (define-syntax message-case (syntax-rules (else) @@ -155,6 +152,7 @@ (define *standard-error-port* #f) (define *current-output-port* #f) + (define *current-error-port* #f) (define standard-output-port (lambda () *standard-output-port*)) @@ -173,6 +171,14 @@ (set! *current-output-port* p) (error 'current-output-port "not an output port" p))])) + (define current-error-port + (case-lambda + [() *current-error-port*] + [(p) + (if (output-port? p) + (set! *current-error-port* p) + (error 'current-error-port "not an error port" p))])) + (define open-output-file (case-lambda [(filename) @@ -224,4 +230,8 @@ (set! *standard-error-port* (make-output-port (make-output-file-handler 2 '*stderr*) - ($make-bytevector 4096))) ) + ($make-bytevector 4096))) + (set! *current-error-port* *standard-error-port*) + + + ) diff --git a/scheme/last-revision b/scheme/last-revision index 1afd47a..aa309cc 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1121 +1122 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index b7c9594..276aee2 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1156,7 +1156,7 @@ [output-port? i r is ip se] [current-input-port i r ip is se] [current-output-port i r ip is se] - [current-error-port r ip is] + [current-error-port i r ip is] [eof-object i r ip is se] [eof-object? i r ip is] [close-input-port i r is se]