Use the new `set-port-next-location!' instead of the previous hack.

(But something might still be off -- I thought that its use in readline
would render the whole thing redundant.)
This commit is contained in:
Eli Barzilay 2011-07-14 17:21:27 -04:00
parent db7f2b4542
commit 95f6eb4f3e

View File

@ -73,36 +73,26 @@
(and (symbol? sym) (and (symbol? sym)
(with-handlers ([exn? (λ (_) #f)]) (module->imports `',sym) #t))) (with-handlers ([exn? (λ (_) #f)]) (module->imports `',sym) #t)))
;; support visual column-aware output (define last-output-port #f)
;; right after an input expression is entered the terminal won't show the
;; newline, so as far as column counting goes it's still after the prompt which
;; leads to bad output in practice. (at least in the common case where IO
;; share the same terminal.) This will be redundant with the already-added
;; `port-set-next-location!'.
(define last-output-port #f)
(define last-output-line #f)
(define last-output-visual-col #f)
(define (maybe-new-output-port) (define (maybe-new-output-port)
(unless (eq? last-output-port (current-output-port)) (unless (eq? last-output-port (current-output-port))
(when last-output-port (flush-output last-output-port)) ; just in case
(set! last-output-port (current-output-port)) (set! last-output-port (current-output-port))
(flush-output last-output-port) (flush-output last-output-port)
(port-count-lines! last-output-port) (port-count-lines! last-output-port)))
(let-values ([(line col pos) (port-next-location last-output-port)])
(set! last-output-line line)
(set! last-output-visual-col col))))
(define (fresh-line) (define (fresh-line)
(maybe-new-output-port) (maybe-new-output-port)
(flush-output last-output-port) (flush-output last-output-port)
(let-values ([(line col pos) (port-next-location last-output-port)]) (define-values [line col pos] (port-next-location last-output-port))
(unless (eq? col (if (eq? line last-output-line) last-output-visual-col 0)) (unless (eq? col 0) (newline)))
(newline))))
(define (prompt-shown) (define (prompt-shown)
;; right after an input expression is entered the terminal won't show the
;; newline, so as far as column counting goes it's still after the prompt
;; which leads to bad output in practice. (at least in the common case where
;; IO share the same terminal.)
(maybe-new-output-port) (maybe-new-output-port)
;; if there was a way to change the location of stdout we'd set the column to (define-values [line col pos] (port-next-location last-output-port))
;; 0 here... (set-port-next-location! last-output-port line 0 pos))
(let-values ([(line col pos) (port-next-location last-output-port)])
(set! last-output-line line)
(set! last-output-visual-col col)))
;; wrapped `printf' (cheap but effective), aware of the visual col ;; wrapped `printf' (cheap but effective), aware of the visual col
(define wrap-prefix (make-parameter "")) (define wrap-prefix (make-parameter ""))
@ -114,9 +104,7 @@
(write-string (car strs) o) (write-string (car strs) o)
(for ([str (in-list (cdr strs))]) (for ([str (in-list (cdr strs))])
(define-values [line col pos] (port-next-location o)) (define-values [line col pos] (port-next-location o))
(define vcol (if ((+ col (string-length str)) . >= . wcol)
(if (eq? line last-output-line) (- col last-output-visual-col) col))
(if ((+ vcol (string-length str)) . >= . wcol)
(begin (newline o) (write-string pfx o)) (begin (newline o) (write-string pfx o))
(write-string " " o)) (write-string " " o))
(write-string str o)))) (write-string str o))))