97 lines
3.4 KiB
Scheme
97 lines
3.4 KiB
Scheme
#lang scheme/base
|
|
|
|
(require mzlib/port
|
|
"private/portlines.ss")
|
|
(provide (except-out (all-from-out mzlib/port)
|
|
strip-shell-command-start)
|
|
port->string
|
|
port->bytes
|
|
port->lines
|
|
port->bytes-lines
|
|
port->list
|
|
display-lines
|
|
|
|
with-output-to-string
|
|
with-output-to-bytes
|
|
call-with-output-string
|
|
call-with-output-bytes
|
|
|
|
with-input-from-string
|
|
with-input-from-bytes
|
|
call-with-input-string
|
|
call-with-input-bytes)
|
|
|
|
(define (port->string-port who p)
|
|
(unless (input-port? p) (raise-type-error who "input-port" p))
|
|
(let ([s (open-output-string)]) (copy-port p s) s))
|
|
|
|
(define (port->string [p (current-input-port)])
|
|
(get-output-string (port->string-port 'port->string p)))
|
|
|
|
(define (port->bytes [p (current-input-port)])
|
|
(get-output-bytes (port->string-port 'port->bytes p) #t))
|
|
|
|
(define (port->lines [p (current-input-port)] #:line-mode [mode 'any])
|
|
(port->x-lines 'port->lines p mode read-line))
|
|
|
|
(define (port->bytes-lines [p (current-input-port)] #:line-mode [mode 'any])
|
|
(port->x-lines 'port->bytes-lines p mode read-bytes-line))
|
|
|
|
(define (port->list [r read] [p (current-input-port)])
|
|
(unless (input-port? p)
|
|
(raise-type-error 'port->list "input-port" p))
|
|
(unless (and (procedure? r) (procedure-arity-includes? r 1))
|
|
(raise-type-error 'port->list "procedure (arity 1)" r))
|
|
(for/list ([v (in-port r p)]) v))
|
|
|
|
(define (display-lines l [p (current-output-port)] #:separator [newline #"\n"])
|
|
(unless (list? l) (raise-type-error 'display-lines "list" l))
|
|
(unless (output-port? p) (raise-type-error 'display-lines "output-port" p))
|
|
(do-lines->port l p newline))
|
|
|
|
(define (with-output-to-x who n proc)
|
|
(unless (and (procedure? proc) (procedure-arity-includes? proc n))
|
|
(raise-type-error who (format "procedure (arity ~a)" n) proc))
|
|
(let ([s (open-output-bytes)])
|
|
;; Use `dup-output-port' to hide string-port-ness of s:
|
|
(if (zero? n)
|
|
(parameterize ([current-output-port (dup-output-port s #t)])
|
|
(proc))
|
|
(proc (dup-output-port s #t)))
|
|
s))
|
|
|
|
(define (with-output-to-string proc)
|
|
(get-output-string (with-output-to-x 'with-output-to-string 0 proc)))
|
|
|
|
(define (with-output-to-bytes proc)
|
|
(get-output-bytes (with-output-to-x 'with-output-to-bytes 0 proc) #t))
|
|
|
|
(define (call-with-output-string proc)
|
|
(get-output-string (with-output-to-x 'call-with-output-string 1 proc)))
|
|
|
|
(define (call-with-output-bytes proc)
|
|
(get-output-bytes (with-output-to-x 'call-with-output-bytes 1 proc) #t))
|
|
|
|
(define (with-input-from-x who n b? str proc)
|
|
(unless (if b? (bytes? str) (string? str))
|
|
(raise-type-error who (if b? "byte string" "string") 0 str proc))
|
|
(unless (and (procedure? proc) (procedure-arity-includes? proc n))
|
|
(raise-type-error who (format "procedure (arity ~a)" n) 1 str proc))
|
|
(let ([s (if b? (open-input-bytes str) (open-input-string str))])
|
|
(if (zero? n)
|
|
(parameterize ([current-input-port s])
|
|
(proc))
|
|
(proc s))))
|
|
|
|
(define (with-input-from-string str proc)
|
|
(with-input-from-x 'with-input-from-string 0 #f str proc))
|
|
|
|
(define (with-input-from-bytes str proc)
|
|
(with-input-from-x 'with-input-from-bytes 0 #t str proc))
|
|
|
|
(define (call-with-input-string str proc)
|
|
(with-input-from-x 'call-with-input-string 1 #f str proc))
|
|
|
|
(define (call-with-input-bytes str proc)
|
|
(with-input-from-x 'call-with-input-bytes 1 #t str proc))
|