diff --git a/racket/src/io/demo.rkt b/racket/src/io/demo.rkt index e1571974ca..dc88c1dad7 100644 --- a/racket/src/io/demo.rkt +++ b/racket/src/io/demo.rkt @@ -129,6 +129,26 @@ (fprintf (current-output-port) "*~v*" '!!!) (newline) +(parameterize ([error-print-width 5]) + (test "abc" (format "~.a" "abc")) + (test "abcde" (format "~.a" "abcde")) + (test "ab..." (format "~.a" "abcdef")) + (test "abc" (format "~.a" #"abc")) + (test "abcde" (format "~.a" #"abcde")) + (test "ab..." (format "~.a" #"abcdef")) + (test "ab..." (format "~.a" 'abcdef)) + (test "\"ab\"" (format "~.s" "ab")) + (test "\"abc\"" (format "~.s" "abc")) + (test "\"a..." (format "~.s" "abcde")) + (test "#\"a\"" (format "~.s" #"a")) + (test "#\"ab\"" (format "~.s" #"ab")) + (test "#\"..." (format "~.s" #"abc")) + (test "#\"..." (format "~.s" #"abcdef")) + (test "|a b|" (format "~.s" '|a b|)) + (test "|a..." (format "~.s" '|a bx|)) + (test "(1 2)" (format "~.a" '(1 2))) + (test "(1..." (format "~.a" '(10 2)))) + (test "no: hi 10" (with-handlers ([exn:fail? exn-message]) (error 'no "hi ~s" 10))) diff --git a/racket/src/io/print/bytes.rkt b/racket/src/io/print/bytes.rkt index fa7fa7c503..26672b34b5 100644 --- a/racket/src/io/print/bytes.rkt +++ b/racket/src/io/print/bytes.rkt @@ -10,10 +10,15 @@ (let loop ([start-i 0] [i 0] [max-length max-length]) (cond [(eq? max-length 'full) 'full] - [(or (= i len) - (and max-length ((- i start-i) . > . max-length))) + [(= i len) (let ([max-length (write-bytes/max bstr o max-length start-i i)]) (write-bytes/max #"\"" o max-length))] + [(and max-length + (or (pair? max-length) + ((- i start-i) . > . max-length))) + ;; Getting full: abandon block mode so that we stop earlier + (let ([max-length (write-bytes/max bstr o max-length start-i i)]) + (loop i (add1 i) max-length))] [else (define b (bytes-ref bstr i)) (cond diff --git a/racket/src/io/print/main.rkt b/racket/src/io/print/main.rkt index a1747b7c30..02a3b8fdc5 100644 --- a/racket/src/io/print/main.rkt +++ b/racket/src/io/print/main.rkt @@ -158,12 +158,20 @@ (define (sub3 n) (and n (- n 3))) (define (dots max-length o) - (when (eq? max-length 'full) - (write-string "..." o))) + (cond + [(eq? max-length 'full) + (write-string "..." o)] + [(pair? max-length) + ;; pending bytes fit after all + (write-bytes (cdr max-length) o)] + [else (void)])) ;; ---------------------------------------- -;; Returns the max length that is still available +;; Returns the max length that is still available, where 'full +;; means that more than three items would otherwise have been +;; written, and a pair indicates that some bytes/characters are +;; pending until the rest of the writes are determined (define (p who v mode o max-length graph config) (cond [(and graph (hash-ref graph v #f)) diff --git a/racket/src/io/print/string.rkt b/racket/src/io/print/string.rkt index 68924dd81b..ccbbf4846b 100644 --- a/racket/src/io/print/string.rkt +++ b/racket/src/io/print/string.rkt @@ -10,10 +10,15 @@ (let loop ([start-i 0] [i 0] [max-length max-length]) (cond [(eq? max-length 'full) 'full] - [(or (= i len) - (and max-length ((- i start-i) . > . max-length))) + [(= i len) (let ([max-length (write-string/max str o max-length start-i i)]) (write-bytes/max #"\"" o max-length))] + [(and max-length + (or (pair? max-length) + ((- i start-i) . > . max-length))) + ;; Getting full: abandon block mode so that we stop earlier + (let ([max-length (write-string/max str o max-length start-i i)]) + (loop i (add1 i) max-length))] [else (define c (string-ref str i)) (define escaped diff --git a/racket/src/io/print/write-with-max.rkt b/racket/src/io/print/write-with-max.rkt index 1040126ac5..a674cc19c1 100644 --- a/racket/src/io/print/write-with-max.rkt +++ b/racket/src/io/print/write-with-max.rkt @@ -2,7 +2,8 @@ (require "../port/string-output.rkt" "../port/bytes-output.rkt" "../port/port.rkt" - "../port/max-output-port.rkt") + "../port/max-output-port.rkt" + "../string/convert.rkt") (provide write-string/max write-bytes/max @@ -16,15 +17,17 @@ [(not max-length) (write-string str o start end) #f] + [(pair? max-length) + (more-pending max-length start end str)] [else (define len (- end start)) (cond - [(len . < . max-length) + [(len . <= . max-length) (write-string str o start end) (- max-length len)] [else (write-string str o start (+ start max-length)) - 'full])])) + (more-pending '(0 . #"") (+ start max-length) end str)])])) ;; For measuring purposes, just treat bytes as characters: (define (write-bytes/max bstr o max-length [start 0] [end (bytes-length bstr)]) @@ -33,15 +36,29 @@ [(not max-length) (write-bytes bstr o start end) #f] + [(pair? max-length) + (more-pending max-length start end bstr)] [else (define len (- end start)) (cond - [(len . < . max-length) + [(len . <= . max-length) (write-bytes bstr o start end) (- max-length len)] [else (write-bytes bstr o start (+ start max-length)) - 'full])])) + (more-pending '(0 . #"") (+ start max-length) end bstr)])])) + +(define (more-pending max-length start end str) + (define prev-pending (car max-length)) + (define len (- end start)) + (define new-pending (+ len prev-pending)) + (cond + [(new-pending . > . 3) 'full] + [else (cons new-pending + (bytes-append (cdr max-length) + (if (string? str) + (string->bytes/utf-8 str #f start end) + (subbytes str start end))))])) (define (make-output-port/max o max-length) (make-max-output-port o max-length))