conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fixes bug 164725: missing current-error-port

This commit is contained in:
Abdulaziz Ghuloum 2007-11-23 14:46:42 -05:00
parent 8640cb785d
commit d74b82fe7d
3 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
scheme/ikarus.io.output-files.ss
View File

@ -16,7 +16,7 @@
(library (ikarus io output-files) (library (ikarus io output-files)
(export standard-output-port standard-error-port (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) open-output-file with-output-to-file call-with-output-file)
(import (import
(ikarus system $ports) (ikarus system $ports)
@ -28,11 +28,8 @@
(rnrs bytevectors) (rnrs bytevectors)
(except (ikarus) (except (ikarus)
standard-output-port standard-error-port standard-output-port standard-error-port
console-output-port current-output-port console-output-port current-output-port current-error-port
*standard-output-port* *standard-error-port* open-output-file with-output-to-file call-with-output-file))
*current-output-port*
open-output-file with-output-to-file
call-with-output-file))
(define-syntax message-case (define-syntax message-case
(syntax-rules (else) (syntax-rules (else)
@ -155,6 +152,7 @@
(define *standard-error-port* #f) (define *standard-error-port* #f)
(define *current-output-port* #f) (define *current-output-port* #f)
(define *current-error-port* #f)
(define standard-output-port (define standard-output-port
(lambda () *standard-output-port*)) (lambda () *standard-output-port*))
@ -173,6 +171,14 @@
(set! *current-output-port* p) (set! *current-output-port* p)
(error 'current-output-port "not an 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 (define open-output-file
(case-lambda (case-lambda
[(filename) [(filename)
@ -224,4 +230,8 @@
(set! *standard-error-port* (set! *standard-error-port*
(make-output-port (make-output-port
(make-output-file-handler 2 '*stderr*) (make-output-file-handler 2 '*stderr*)
($make-bytevector 4096))) ) ($make-bytevector 4096)))
(set! *current-error-port* *standard-error-port*)
)

2
scheme/last-revision
View File

@ -1 +1 @@
1121 1122

2
scheme/makefile.ss
View File

@ -1156,7 +1156,7 @@
[output-port? i r is ip se] [output-port? i r is ip se]
[current-input-port i r ip is se] [current-input-port i r ip is se]
[current-output-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 se]
[eof-object? i r ip is] [eof-object? i r ip is]
[close-input-port i r is se] [close-input-port i r is se]