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

- added "output-port-buffer-mode" which returns "none" or "block". 

(there is no line buffering yet)
- updated error message when using unimplemented features.
This commit is contained in:
Abdulaziz Ghuloum 2008-12-09 04:46:43 -05:00
parent b31454d592
commit eec9567014
3 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
scheme/ikarus.io.ss
View File

@ -39,7 +39,7 @@
port-position port-has-port-position? port-position port-has-port-position?
set-port-position! port-has-set-port-position!? set-port-position! port-has-set-port-position!?
call-with-port call-with-port
flush-output-port flush-output-port
put-u8 put-bytevector put-u8 put-bytevector
put-char write-char put-char write-char
put-string put-string
@ -58,6 +58,7 @@
console-input-port console-input-port
newline newline
port-mode set-port-mode! port-mode set-port-mode!
output-port-buffer-mode
reset-input-port! reset-input-port!
reset-output-port! reset-output-port!
port-id port-id
@ -117,6 +118,7 @@
console-error-port console-error-port
newline newline
port-mode set-port-mode! port-mode set-port-mode!
output-port-buffer-mode
reset-input-port! reset-input-port!
reset-output-port! reset-output-port!
port-id port-id
@ -1587,6 +1589,16 @@
(open-output-file-handle filename file-options who) (open-output-file-handle filename file-options who)
filename buffer-size transcoder #t who))])) filename buffer-size transcoder #t who))]))
(define (output-port-buffer-mode p)
(unless (output-port? p)
(die 'output-port-buffer-mode "not an output port" p))
(let ([buff ($port-buffer p)])
(if (if (string? buff)
(fx= 1 (string-length buff))
(fx= 1 (bytevector-length buff)))
'none
'block)))
(define (open-output-file filename) (define (open-output-file filename)
(unless (string? filename) (unless (string? filename)
(die 'open-output-file "invalid filename" filename)) (die 'open-output-file "invalid filename" filename))

11
scheme/ikarus.not-yet-implemented.ss
View File

@ -5,7 +5,7 @@
bitwise-rotate-bit-field fxreverse-bit-field bitwise-rotate-bit-field fxreverse-bit-field
make-custom-binary-input/output-port make-custom-binary-input/output-port
make-custom-textual-input/output-port make-custom-textual-input/output-port
open-file-input/output-port output-port-buffer-mode open-file-input/output-port
equal-hash) equal-hash)
(import (except (ikarus) (import (except (ikarus)
@ -13,7 +13,7 @@
bitwise-rotate-bit-field fxreverse-bit-field bitwise-rotate-bit-field fxreverse-bit-field
make-custom-binary-input/output-port make-custom-binary-input/output-port
make-custom-textual-input/output-port make-custom-textual-input/output-port
open-file-input/output-port output-port-buffer-mode open-file-input/output-port
equal-hash)) equal-hash))
(define-syntax not-yet (define-syntax not-yet
@ -29,11 +29,11 @@
(condition (condition
(make-error) (make-error)
(make-who-condition 'ikarus) (make-who-condition 'ikarus)
(make-message-condition "primitive not supported yet") (make-message-condition "primitive not supported")
(make-message-condition (make-message-condition
"please file a bug report to help us prioritize our goals") "Please visit the Ikarus FAQs page for more information")
(make-url-condition (make-url-condition
"https://bugs.launchpad.net/ikarus/+filebug") "https://answers.launchpad.net/ikarus/+faqs")
(make-irritants-condition (list op))))) (make-irritants-condition (list op)))))
(define (x* . args) (bug 'x*)) (define (x* . args) (bug 'x*))
...)])) ...)]))
@ -48,7 +48,6 @@
make-custom-binary-input/output-port make-custom-binary-input/output-port
make-custom-textual-input/output-port make-custom-textual-input/output-port
open-file-input/output-port open-file-input/output-port
output-port-buffer-mode
)) ))

2
scheme/last-revision
View File

@ -1 +1 @@
1710 1711