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

Some improvements to `install-readline!', make it report what it did, and make

Browse Source 
it add a comment before the new expression.

svn: r17387
This commit is contained in:
Eli Barzilay 2009-12-22 19:35:13 +00:00
parent 5994c5de59
commit 5681037aff
2 changed files with 25 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/readline/readline.scrbl
View File

@ -45,7 +45,7 @@ shell---then you can use @scheme[dynamic-require], as in the following
example:
@schemeblock[
(when (regexp-match? #rx"xterm"
(when (regexp-match? #rx"xterm"
(getenv "TERM"))
(dynamic-require 'readline #f))
]
@ -65,13 +65,15 @@ exits normally.
@defproc[(install-readline!) void?]{
Adds @scheme[(require readline)] to the result of
Adds @scheme[(require readline/rep)] to the result of
@scheme[(find-system-path 'init-file)], which is
@filepath{~/.mzschemerc} under Unix. Consequently, @|readline| will be
loaded whenever MzScheme is started in interactive mode. The
declaration is added only if it is not already present, as determined
by @scheme[read]ing and checking all top-level expressions in the
file. For more fine-grained control, such as conditionally loading
file.
For more fine-grained control, such as conditionally loading
@|readline| based on an environment variable, edit
@filepath{~/.mzschemerc} manually.}

45
collects/readline/rep.ss
View File

@ -1,7 +1,7 @@
;; This is a wrapper around "rep-start.ss" -- use it if we're using a terminal
#lang scheme/base
(require scheme/runtime-path)
(require scheme/runtime-path scheme/file)
(define-runtime-path rep-start "rep-start.ss")
@ -15,27 +15,22 @@
'(require readline/rep))
(define (install-readline!)
(let ([file (find-system-path 'init-file)])
(when (or (not (file-exists? file))
(not (with-handlers ([exn:fail?
(lambda (exn)
(error 'install-readline!
"trouble reading existing ~e: ~a"
file
(exn-message exn)))])
(call-with-input-file*
file
(lambda (in)
(let loop ()
(let ([v (read in)])
(cond
[(eof-object? v) #f]
[(equal? v readline-init-expr) #t]
[else (loop)]))))))))
(call-with-output-file*
file
#:exists 'append
(lambda (out)
(newline out)
(write readline-init-expr out)
(newline out))))))
(define file (find-system-path 'init-file))
(define (add! msg)
(call-with-output-file* file #:exists 'append
(lambda (o)
(fprintf o "\n;; load readline support ~a\n~s\n"
"(added by `install-readline!')"
readline-init-expr)))
(printf msg file))
(cond [(not (file-exists? file))
(add! "\"~a\" created and readline initialization added.\n")]
[(with-handlers ([exn:fail?
(lambda (exn)
(error 'install-readline!
"trouble reading existing ~e: ~a"
file
(exn-message exn)))])
(not (member readline-init-expr (file->list file))))
(add! "Readline initialization added to \"~a\".\n")]
[else (printf "Readline already installed in \"~a\".\n" file)]))