Rename prompt-shown' -> zero-column!', and use it only in the

non-readline reader.  Use line reading for ,install!.
This commit is contained in:
Eli Barzilay 2011-07-15 18:21:33 -04:00
parent 3a1dde7f14
commit 3f8bb7a453

View File

@ -85,11 +85,11 @@
(flush-output last-output-port) (flush-output last-output-port)
(define-values [line col pos] (port-next-location last-output-port)) (define-values [line col pos] (port-next-location last-output-port))
(unless (eq? col 0) (newline))) (unless (eq? col 0) (newline)))
(define (prompt-shown) (define (zero-column!)
;; right after an input expression is entered the terminal won't show the ;; there's a problem whenever there's some printout followed by a read: the
;; newline, so as far as column counting goes it's still after the prompt ;; cursor will at column zero, but the port counting will think that it's
;; which leads to bad output in practice. (at least in the common case where ;; still right after the printout; call this function in such cases to adjust
;; IO share the same terminal.) ;; the column to 0.
(maybe-new-output-port) (maybe-new-output-port)
(define-values [line col pos] (port-next-location last-output-port)) (define-values [line col pos] (port-next-location last-output-port))
(set-port-next-location! last-output-port line 0 pos)) (set-port-next-location! last-output-port line 0 pos))
@ -1009,6 +1009,7 @@
(define expr "(require xrepl)") (define expr "(require xrepl)")
(define dexpr "(dynamic-require 'xrepl #f)") (define dexpr "(dynamic-require 'xrepl #f)")
(define contents (file->string init-file)) (define contents (file->string init-file))
(read-line) ; discard the newline for further input
(define (look-for comment-rx expr) (define (look-for comment-rx expr)
(let ([m (regexp-match-positions (let ([m (regexp-match-positions
(format "(?<=\r?\n|^) *;+ *~a *\r?\n *~a *(?=\r?\n|$)" (format "(?<=\r?\n|^) *;+ *~a *\r?\n *~a *(?=\r?\n|$)"
@ -1018,9 +1019,7 @@
(define existing? (look-for (regexp-quote comment) expr)) (define existing? (look-for (regexp-quote comment) expr))
(define existing-readline? (define existing-readline?
(look-for "load readline support[^\r\n]*" "(require readline/rep)")) (look-for "load readline support[^\r\n]*" "(require readline/rep)"))
(define (yes?) (define (yes?) (flush-output) (regexp-match? #rx"^[yY]" (getarg 'line)))
(flush-output)
(begin0 (regexp-match? #rx"^[yY]" (getarg 'string)) (prompt-shown)))
(cond (cond
[existing? [existing?
(printf "; already installed, nothing to do\n") (printf "; already installed, nothing to do\n")
@ -1175,7 +1174,7 @@
(provide make-command-reader) (provide make-command-reader)
(define (make-command-reader) (define (make-command-reader)
(define (plain-reader prefix) ; a plain reader, without readline (define (plain-reader prefix) ; a plain reader, without readline
(display prefix) (display "> ") (flush-output) (display prefix) (display "> ") (flush-output) (zero-column!)
(let ([in ((current-get-interaction-input-port))]) (let ([in ((current-get-interaction-input-port))])
((current-read-interaction) (object-name in) in))) ((current-read-interaction) (object-name in) in)))
(define RL ; no direct dependency on readline (define RL ; no direct dependency on readline
@ -1221,7 +1220,7 @@
(define input (define input
(if from-queue? (if from-queue?
(begin0 (car more-inputs) (set! more-inputs (cdr more-inputs))) (begin0 (car more-inputs) (set! more-inputs (cdr more-inputs)))
(begin (fresh-line) (begin0 (reader (get-prefix)) (prompt-shown))))) (begin (fresh-line) (reader (get-prefix)))))
(syntax-case input () (syntax-case input ()
[(uq cmd) (eq? 'unquote (syntax-e #'uq)) [(uq cmd) (eq? 'unquote (syntax-e #'uq))
(let ([r (run-command (syntax->datum #'cmd))]) (let ([r (run-command (syntax->datum #'cmd))])