diff --git a/pkgs/racket-doc/scribblings/reference/write.scrbl b/pkgs/racket-doc/scribblings/reference/write.scrbl index 50262350a5..fc1ea1b67d 100644 --- a/pkgs/racket-doc/scribblings/reference/write.scrbl +++ b/pkgs/racket-doc/scribblings/reference/write.scrbl @@ -117,7 +117,7 @@ escapes: @item{@FmtMark{.}@nonterm{c} where @nonterm{c} is @litchar{a}, @litchar{A}, @litchar{s}, @litchar{S}, @litchar{v}, or @litchar{V}: - truncates @racket[display], @racket[write], or @racket[print] output + truncates default-handler @racket[display], @racket[write], or @racket[print] output to @racket[(error-print-width)] characters, using @litchar{...} as the last three characters if the untruncated output would be longer} diff --git a/pkgs/racket-test-core/tests/racket/file.rktl b/pkgs/racket-test-core/tests/racket/file.rktl index e113d4e1c8..04585adf58 100644 --- a/pkgs/racket-test-core/tests/racket/file.rktl +++ b/pkgs/racket-test-core/tests/racket/file.rktl @@ -914,6 +914,39 @@ (err/rt-test (port-write-handler sp (lambda (x) 9))) (err/rt-test (port-write-handler sp (lambda (x y z) 9))) +;; Check use of handlers by `printf` +(let () + (define p (open-output-bytes)) + (port-display-handler p (lambda (x p) + (write-bytes #"D" p))) + (port-write-handler p (lambda (x p) + (write-bytes #"W" p))) + (port-print-handler p (lambda (x p [d 0]) + (write-bytes #"P" p))) + + (display 'x p) + (fprintf p "~a" 'y) + (fprintf p "~.a" 'z) ; does not use handler + + (write 'x p) + (fprintf p "~s" 'y) + (fprintf p "~.s" 'z) ; does not use handler + + (print 'x p) + (fprintf p "~v" 'y) + (fprintf p "~.v" 'z) ; does not use handler + + (test #"DDzWWzPP'z" get-output-bytes p)) + +;; Make sure `printf` works with wrapped ports +(let () + (struct w (p) #:property prop:output-port (struct-field-index p)) + (define o (open-output-bytes)) + (define p (w o)) + + (fprintf p "0~a~a~s~v~.a~a~.s~.v" 1 #"1" 2 3 4 #"4" 5 6) + (test #"011234456" get-output-bytes o)) + ;;------------------------------------------------------------ ;; peek-string and variants: diff --git a/racket/src/io/format/printf.rkt b/racket/src/io/format/printf.rkt index 27ff0c3b09..45e71cc0cc 100644 --- a/racket/src/io/format/printf.rkt +++ b/racket/src/io/format/printf.rkt @@ -1,7 +1,9 @@ #lang racket/base (require "../print/main.rkt" (submod "../print/main.rkt" internal) - "../port/string-output.rkt") + "../print/mode.rkt" + "../port/string-output.rkt" + "../port/output-port.rkt") (provide do-printf) @@ -86,13 +88,13 @@ (write-string "\n" o) (next i args)] [(#\a #\A) - (do-display who (car args) o) + (display-via-handler who (car args) o) (next i (cdr args))] [(#\s #\S) - (do-write who (car args) o) + (write-via-handler who (car args) o) (next i (cdr args))] [(#\v #\V) - (do-global-print who (car args) o) + (print-via-handler who (car args) o PRINT-MODE/UNQUOTED) (next i (cdr args))] [(#\e #\E) (parameterize ([print-unreadable #t]) @@ -105,15 +107,15 @@ (let ([i (add1 i)]) (case (string-ref fmt i) [(#\a #\A) - (do-display who (car args) o (error-print-width)) + (do-display who (car args) (->core-output-port o) (error-print-width)) (next i (cdr args))] [(#\s #\S) - (do-write who (car args) o (error-print-width)) + (do-write who (car args) (->core-output-port o) (error-print-width)) (next i (cdr args))] [(#\v #\V) ;; Intentionally using `do-print` instead of ;; `do-global-print`: - (do-print who (car args) o 0 (error-print-width)) + (do-print who (car args) (->core-output-port o) 0 (error-print-width)) (next i (cdr args))]))] [(#\x #\X) (write-string (number->string (car args) 16) o) diff --git a/racket/src/io/port/handler.rkt b/racket/src/io/port/handler.rkt index 02f9a00fb7..9c2cd74b89 100644 --- a/racket/src/io/port/handler.rkt +++ b/racket/src/io/port/handler.rkt @@ -76,8 +76,8 @@ h)))])) (define/who (default-port-write-handler v o) - (check who output-port? o) - (do-write 'write v o)) + (let ([co (->core-output-port o who)]) + (do-write 'write v co))) (define/who port-display-handler (case-lambda @@ -95,8 +95,8 @@ h)))])) (define/who (default-port-display-handler v o) - (check who output-port? o) - (do-display 'display v o)) + (let ([co (->core-output-port o who)]) + (do-display 'display v co))) (define/who port-print-handler (case-lambda @@ -125,11 +125,11 @@ ((global-port-print-handler) v o quote-depth)) (define/who (default-global-port-print-handler v o [quote-depth 0]) - (check who output-port? o) - (check who (lambda (d) (or (eq? d 0) (eq? d 1))) - #:contract "(or/c 0 1)" - quote-depth) - (do-print 'print v o quote-depth)) + (let ([co (->core-output-port o who)]) + (check who (lambda (d) (or (eq? d 0) (eq? d 1))) + #:contract "(or/c 0 1)" + quote-depth) + (do-print 'print v co quote-depth))) (define/who global-port-print-handler (make-parameter default-global-port-print-handler diff --git a/racket/src/io/print/main.rkt b/racket/src/io/print/main.rkt index 9dc8589acd..29f3cffebe 100644 --- a/racket/src/io/print/main.rkt +++ b/racket/src/io/print/main.rkt @@ -45,7 +45,11 @@ (all-from-out "parameter.rkt")) (module+ internal - (provide do-display + (provide display-via-handler + write-via-handler + print-via-handler + + do-display do-write do-print do-global-print @@ -53,6 +57,9 @@ install-do-global-print!)) (define/who (display v [o (current-output-port)]) + (display-via-handler who v o)) + +(define (display-via-handler who v o) (let ([co (->core-output-port o who)]) (define display-handler (core-output-port-display-handler co)) (if display-handler @@ -74,6 +81,9 @@ (void)])) (define/who (write v [o (current-output-port)]) + (write-via-handler who v o)) + +(define (write-via-handler who v o) (let ([co (->core-output-port o who)]) (define write-handler (core-output-port-write-handler co)) (if write-handler @@ -87,6 +97,9 @@ (void)) (define/who (print v [o (current-output-port)] [quote-depth PRINT-MODE/UNQUOTED]) + (print-via-handler who v o quote-depth)) + +(define/who (print-via-handler who v o quote-depth) (let ([co (->core-output-port o who)]) (check who print-mode? #:contract "(or/c 0 1)" quote-depth) (define print-handler (core-output-port-print-handler co))