summaryrefslogtreecommitdiff
path: root/scheme/racket
diff options
context:
space:
mode:
Diffstat (limited to 'scheme/racket')
-rw-r--r--scheme/racket/geiser/modules.rkt36
-rw-r--r--scheme/racket/geiser/user.rkt23
2 files changed, 38 insertions, 21 deletions
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 9e6e14c..2c57db9 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -1,6 +1,6 @@
;;; modules.rkt -- module metadata
-;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the Modified BSD License. You should
@@ -51,11 +51,16 @@
(when (namespace? ns)
(current-namespace ns))))
-(define (namespace->module-path-name ns)
- (let ([rmp (variable-reference->resolved-module-path
- (eval '(#%variable-reference) (or ns (current-namespace))))])
- (and (resolved-module-path? rmp)
- (resolved-module-path-name rmp))))
+(define (namespace->rmp ns)
+ (with-handlers ([exn? (const #f)])
+ (variable-reference->resolved-module-path
+ (eval '(#%variable-reference) (or ns (current-namespace))))))
+
+(define (namespace->module-path-name ns (p #f))
+ (let ([rmp (namespace->rmp ns)])
+ (or (and (resolved-module-path? rmp)
+ (resolved-module-path-name rmp))
+ p)))
(define (module-spec->path-name spec)
(and (symbol? spec)
@@ -64,10 +69,13 @@
(namespace->module-path-name
(module-spec->namespace spec #f #f))))))
+(define unknown-module-name "*unresolved module*")
+
(define (module-path-name->name path)
- (cond [(path? path)
- (let* ([path (path->string path)]
- [cpaths (map (compose path->string path->directory-path)
+ (cond [(path? path) (module-path-name->name (path->string path))]
+ ;; [(eq? path '#%kernel) "(kernel)"]
+ [(string? path)
+ (let* ([cpaths (map (compose path->string path->directory-path)
(current-library-collection-paths))]
[prefix-len (lambda (p)
(let ((pl (string-length p)))
@@ -80,19 +88,17 @@
(let-values ([(_ base __) (split-path path)])
(path->string base))
(regexp-replace "\\.[^./]*$" real-path "")))]
- ;; [(eq? path '#%kernel) "(kernel)"]
- [(string? path) path]
[(symbol? path) (symbol->string path)]
- [else ""]))
+ [else unknown-module-name]))
(define (module-path-index->name mpi)
(let ([rmp (module-path-index-resolve mpi)])
(if (resolved-module-path? rmp)
(module-path-name->name (resolved-module-path-name rmp))
- "<unknown module>")))
+ unknown-module-name)))
-(define namespace->module-name
- (compose module-path-name->name namespace->module-path-name))
+(define (namespace->module-name ns (p #f))
+ (module-path-name->name (namespace->module-path-name ns p)))
(define (module-identifiers mod)
(define (extract-ids ls)
diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt
index 72aa48a..69a5df7 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -22,13 +22,23 @@
geiser/modules)
(define top-namespace (current-namespace))
+(define last-entered (make-parameter ""))
+
+(define (do-enter mod name)
+ (enter-module mod)
+ (current-namespace (module->namespace mod))
+ (last-entered name))
(define (enter! mod stx)
- (cond [(not mod) (current-namespace top-namespace)]
- [(module-path? mod)
- (enter-module mod)
- (current-namespace (module->namespace mod))]
- [(path-string? mod) (enter! `(file ,mod) stx)]
+ (cond [(not mod)
+ (current-namespace top-namespace)
+ (last-entered "")]
+ [(symbol? mod) (do-enter mod (symbol->string mod))]
+ [(and (list? mod)
+ (= 2 (length mod))
+ (eq? 'file (car mod))
+ (path-string? (cadr mod))) (do-enter mod (cadr mod))]
+ [(path-string? mod) (do-enter `(file ,mod) mod)]
[else (raise-syntax-error
#f
"not a valid module path, and not #f"
@@ -68,7 +78,8 @@
(define geiser-prompt
(lambda ()
- (printf "racket@~a> " (namespace->module-name (current-namespace)))))
+ (printf "racket@~a> "
+ (namespace->module-name (current-namespace) (last-entered)))))
(define (geiser-prompt-read prompt)
(make-repl-reader (geiser-read prompt)))