suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

io: convert make-output-port to object style

Browse Source
This commit is contained in:
Matthew Flatt 2019-02-12 14:39:05 -07:00
parent c57b52eb70
commit 40f27f8153
1 changed files with 22 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
racket/src/io/port/custom-output-port.rkt
View File

@ -132,7 +132,7 @@
(wrap-check-write-evt-result '|user port write| r start end non-block/buffer?)] (wrap-check-write-evt-result '|user port write| r start end non-block/buffer?)]
[else r])])) [else r])]))
(define (get-write-evt self orig-out bstr start end) (define (get-write-evt self bstr start end)
(end-atomic) (end-atomic)
(define r (user-get-write-evt bstr start end)) (define r (user-get-write-evt bstr start end))
(unless (evt? r) (unless (evt? r)
@ -167,25 +167,24 @@
(user-close) (user-close)
(start-atomic)) (start-atomic))
(make-core-output-port (new core-output-port
#:name name #:override
#:self #f ([write-out (if (output-port? user-write-out)
#:evt evt user-write-out
#:write-out write-out)]
(if (output-port? user-write-out) [close close]
user-write-out [write-out-special
write-out) (if (output-port? user-write-out-special)
#:close close user-write-out-special
#:write-out-special (and user-write-out-special write-out-special))]
(if (output-port? user-write-out-special) [get-write-evt (and user-get-write-evt get-write-evt)]
user-write-out-special [get-write-special-evt (and user-get-write-special-evt
(and user-write-out-special write-out-special)) (lambda (self v)
#:get-write-evt (and user-get-write-evt get-write-evt) (user-get-write-special-evt v)))]
#:get-write-special-evt (and user-get-write-special-evt [get-location get-location]
(lambda (self v) [count-lines! count-lines!]
(user-get-write-special-evt v))) [file-position file-position]
#:get-location get-location [buffer-mode buffer-mode])
#:count-lines! count-lines! [name name]
#:init-offset init-offset [evt evt]
#:file-position file-position [offset init-offset]))
#:buffer-mode buffer-mode))