suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix ,install!

Browse Source 
(Questions where very broken when readline was active.)
This commit is contained in:
Eli Barzilay 2012-05-06 13:13:49 -04:00
parent 49c8a5fb28
commit 55814fe7fc
1 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/xrepl/xrepl.rkt
View File

@ -1225,7 +1225,8 @@
(define expr "(require xrepl)") (define expr "(require xrepl)")
(define dexpr "(dynamic-require 'xrepl #f)") (define dexpr "(dynamic-require 'xrepl #f)")
(define contents (if (file-exists? init-file) (file->string init-file) "")) (define contents (if (file-exists? init-file) (file->string init-file) ""))
(read-line) ; discard the newline for further input ;; discard the newline for further input
(let loop () (when (byte-ready?) (read-byte)))
(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|$)"
@ -1236,16 +1237,16 @@
(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? question) (define (yes? question)
(define qtext (format "; ~a? " question)) (define qtext (string->bytes/utf-8 (format "; ~a? " question)))
(define inp (define inp
(case (object-name (current-input-port)) (case (object-name (current-input-port))
[(readline-input) [(readline-input)
(parameterize ([(dynamic-require (parameterize ([(dynamic-require
(collection-file-path "pread.rkt" "readline") (collection-file-path "pread.rkt" "readline")
'current-prompt) 'readline-prompt)
qtext]) qtext])
(read-line))] (read-line))]
[else (display qtext) (flush-output) (read-line)])) [else (write-bytes qtext) (flush-output) (read-line)]))
(and (string? inp) (regexp-match? #px"^[[:space:]]*[yY]" inp))) (and (string? inp) (regexp-match? #px"^[[:space:]]*[yY]" inp)))
(cond (cond
[existing? [existing?
@ -1273,10 +1274,10 @@
(if (yes? "OK to continue") (if (yes? "OK to continue")
(begin (begin
(call-with-output-file* init-file #:exists 'truncate (call-with-output-file* init-file #:exists 'truncate
(λ (o) (write-string (λ (o) (define new (regexp-replace #rx"(?:\r?\n)+$" contents ""))
(string-append (regexp-replace #rx"(?:\r?\n)+$" contents "") (write-string new o)
(format "\n\n;; ~a\n~a\n" comment expr)) (unless (equal? "" new) (write-string "\n\n" o))
o))) (fprintf o ";; ~a\n~a\n" comment expr)))
(printf "; new contents written to ~a\n" init-file)) (printf "; new contents written to ~a\n" init-file))
(printf "; ~a was not updated\n" init-file))]) (printf "; ~a was not updated\n" init-file))])
(void)) (void))