Improve some printouts.
Specifically the one from ,rr. Also make ,switch syntax error more
friendly. Also, test for the recent xrepl fix, including its printout.
(cherry picked from commit e311de0522
)
This commit is contained in:
parent
e32c855a48
commit
42e442a755
|
@ -188,5 +188,18 @@
|
||||||
json/main> «,sh echo $F»
|
json/main> «,sh echo $F»
|
||||||
@|collects|/json/main.rkt
|
@|collects|/json/main.rkt
|
||||||
json/main> «,top»
|
json/main> «,top»
|
||||||
|
-> «(display-to-file "#lang racket\n(provide x)\n(define x 1)\n"
|
||||||
|
"xrepl-test.rkt" #:exists 'truncate)»
|
||||||
|
-> «,rr "xrepl-test.rkt"» ⇒ first load
|
||||||
|
; requiring "xrepl-test.rkt"
|
||||||
|
-> «x»
|
||||||
|
1
|
||||||
|
-> «(display-to-file "#lang racket\n(provide x)\n(define x 2)\n"
|
||||||
|
"xrepl-test.rkt" #:exists 'truncate)»
|
||||||
|
-> «,rr xrepl-test.rkt»
|
||||||
|
; reloading "xrepl-test.rkt"
|
||||||
|
-> «,rm xrepl-test.rkt»
|
||||||
|
-> «x»
|
||||||
|
2
|
||||||
-> «,ex»
|
-> «,ex»
|
||||||
@||})
|
@||})
|
||||||
|
|
|
@ -110,15 +110,18 @@
|
||||||
[best (if (< (string-length best) (string-length x)) best x)])
|
[best (if (< (string-length best) (string-length x)) best x)])
|
||||||
best)))
|
best)))
|
||||||
(define (get-prefix* path)
|
(define (get-prefix* path)
|
||||||
(define x (path->string path))
|
(define x (if (string? path) path (path->string path)))
|
||||||
(define y (->relname path))
|
(define y (->relname path))
|
||||||
(if (equal? x y)
|
(if (equal? x y)
|
||||||
(format "~s" (choose-path x))
|
(format "~s" (choose-path x))
|
||||||
(regexp-replace #rx"[.]rkt$" y "")))
|
(regexp-replace #rx"[.]rkt$" y "")))
|
||||||
(match mod
|
(let loop ([mod mod])
|
||||||
[(? symbol?) (symbol->string mod)]
|
(match mod
|
||||||
[(list 'quote (? symbol? s)) (format "'~a" s)]
|
[(? symbol?) (symbol->string mod)]
|
||||||
[_ (get-prefix* mod)]))
|
[(list 'quote (? symbol? s)) (format "'~a" (loop s))]
|
||||||
|
[(list 'file (? string? s)) (loop (string->path s))]
|
||||||
|
[(or (? path?) (? string?)) (get-prefix* mod)]
|
||||||
|
[_ (error 'xrepl "internal error; ~v" mod)])))
|
||||||
|
|
||||||
(define (here-source) ; returns a path, a symbol, or #f (= not in a module)
|
(define (here-source) ; returns a path, a symbol, or #f (= not in a module)
|
||||||
(variable-reference->module-source
|
(variable-reference->module-source
|
||||||
|
@ -749,14 +752,15 @@
|
||||||
(for ([mod (in-list last-rr-modules)])
|
(for ([mod (in-list last-rr-modules)])
|
||||||
(define resolved ((current-module-name-resolver) mod #f #f #f))
|
(define resolved ((current-module-name-resolver) mod #f #f #f))
|
||||||
(define path (resolved-module-path-name resolved))
|
(define path (resolved-module-path-name resolved))
|
||||||
|
(define disp (module-displayable-name mod))
|
||||||
(if (hash-ref rr-modules resolved #f)
|
(if (hash-ref rr-modules resolved #f)
|
||||||
;; reload
|
;; reload
|
||||||
(begin (printf "; reloading ~a\n" path)
|
(begin (printf "; reloading ~a\n" disp)
|
||||||
(parameterize ([current-module-declare-name resolved])
|
(parameterize ([current-module-declare-name resolved])
|
||||||
(load/use-compiled path)))
|
(load/use-compiled path)))
|
||||||
;; require
|
;; require
|
||||||
(begin (hash-set! rr-modules resolved #t)
|
(begin (hash-set! rr-modules resolved #t)
|
||||||
(printf "; requiring ~a\n" path)
|
(printf "; requiring ~a\n" disp)
|
||||||
;; (namespace-require mod)
|
;; (namespace-require mod)
|
||||||
(eval #`(require #,mod)))))))
|
(eval #`(require #,mod)))))))
|
||||||
|
|
||||||
|
@ -1063,7 +1067,7 @@
|
||||||
(current-namespace-name name)
|
(current-namespace-name name)
|
||||||
(current-namespace (car (hash-ref namespaces name)))))
|
(current-namespace (car (hash-ref namespaces name)))))
|
||||||
(define (syntax-error)
|
(define (syntax-error)
|
||||||
(cmderror "syntax error, see ,help switch-namespace"))
|
(cmderror "syntax error, see \",help ~s\"" (current-command)))
|
||||||
(match (getarg 'sexpr 'list)
|
(match (getarg 'sexpr 'list)
|
||||||
[(list) (cmderror "what do you want to do?")]
|
[(list) (cmderror "what do you want to do?")]
|
||||||
[(list '?) (list-namespaces)]
|
[(list '?) (list-namespaces)]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user