[nongnu] elpa/geiser-racket d0d80d8 079/191: Racket: no errors , entering an R5RS module

[Philip Kaludercic]

branch: elpa/geiser-racket
commit d0d80d8e02b1a5e4cbf9de43e334d0c0c2f64c83
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>

    Racket: no errors ,entering an R5RS module
    
    The catch here is that one cannot use #%variable-reference inside an
    R5RS module, and, as a consequence, namespace->module-path-name was
    failing badly.  The solution is to take note of the module name being
    entered before hand, and use that name in case of error (we could
    actually use that name always, but then cheaters using Racket's enter!
    would see an inconsistent name (which probably they deserve)).
---
 geiser/modules.rkt | 36 +++++++++++++++++++++---------------
 geiser/user.rkt    | 23 +++++++++++++++++------
 2 files changed, 38 insertions(+), 21 deletions(-)

diff --git a/geiser/modules.rkt b/geiser/modules.rkt
index 9e6e14c..2c57db9 100644
--- a/geiser/modules.rkt
+++ b/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/geiser/user.rkt b/geiser/user.rkt
index 72aa48a..69a5df7 100644
--- a/geiser/user.rkt
+++ b/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)))