From 410eaca7a6ed7565bdacc92e411fa20627da08e7 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Fri, 1 May 2009 23:10:53 +0200
Subject: PLT:  Current module in REPL prompt and don't change it after C-cC-l.

---
 scheme/plt/geiser.ss      | 16 ++++------------
 scheme/plt/geiser/eval.ss | 39 ++++++++++++++++++++++++++++++++-------
 2 files changed, 36 insertions(+), 19 deletions(-)

diff --git a/scheme/plt/geiser.ss b/scheme/plt/geiser.ss
index 9f99641..dd6b7c3 100644
--- a/scheme/plt/geiser.ss
+++ b/scheme/plt/geiser.ss
@@ -35,9 +35,7 @@
            geiser/make-repl-reader)
 
   (compile-enforce-module-constants #f)
-  (require (lib "geiser/eval")
-           (lib "geiser/completions")
-           (lib "geiser/locations"))
+  (require geiser/eval geiser/completions geiser/locations)
 
   (define geiser/eval eval-in)
   (define geiser/compile compile-in)
@@ -47,20 +45,14 @@
   (define geiser/completions completions)
   (define geiser/symbol-location symbol-location)
 
-  (define prompt (make-parameter "mzscheme@(geiser)"))
-  (define (geiser/make-repl-reader builtin-reader)
-    (lambda ()
-      (display (prompt))
-      (builtin-reader))))
+  (define (geiser/make-repl-reader)
+    (compose (make-repl-reader (current-prompt-read)) current-namespace)))
 
 (require scheme/help)
 (require 'geiser)
 
 (current-prompt-read
- (let ([old (current-prompt-read)])
-   (lambda ()
-     (current-prompt-read
-      ((dynamic-require ''geiser 'geiser/make-repl-reader) old)))))
+ ((dynamic-require ''geiser 'geiser/make-repl-reader)))
 
 
 ;;; geiser.ss ends here
diff --git a/scheme/plt/geiser/eval.ss b/scheme/plt/geiser/eval.ss
index 55cfb6b..ad69836 100644
--- a/scheme/plt/geiser/eval.ss
+++ b/scheme/plt/geiser/eval.ss
@@ -26,8 +26,11 @@
 
 #lang scheme
 
-(provide eval-in compile-in
-         load-file compile-file)
+(provide eval-in
+         compile-in
+         load-file
+         compile-file
+         make-repl-reader)
 
 (require scheme/enter)
 
@@ -56,6 +59,19 @@
           (module->namespace spec))
         (current-namespace))))
 
+(define (namespace->module-path-name ns)
+  (let ((rmp (variable-reference->resolved-module-path
+              (eval '(#%variable-reference) ns))))
+    (and (resolved-module-path? rmp)
+         (resolved-module-path-name rmp))))
+
+(define (namespace->module-name ns)
+  (let ((path (or (namespace->module-path-name ns) "<top>")))
+    (call-with-values (lambda () (split-path path))
+      (lambda (_ basename __) basename))))
+
+(define last-namespace (make-parameter (current-namespace)))
+
 (define (exn-key e)
   (vector-ref (struct->vector e) 0))
 
@@ -76,13 +92,22 @@
 
 (define (load-file file)
   (with-handlers ((exn? set-last-error))
-    (set-last-result
-     (string-append (with-output-to-string
-                      (lambda ()
-                        (load-module (ensure-spec file) (current-output-port))))
-                    "done.")))
+    (let ((current-path (namespace->module-path-name (last-namespace))))
+      (set-last-result
+       (string-append (with-output-to-string
+                        (lambda ()
+                          (load-module (ensure-spec file) (current-output-port))))
+                      "done."))
+      (load-module (and (path? current-path)
+                        (ensure-spec (path->string current-path))))))
   last-result)
 
 (define compile-file load-file)
 
+(define (make-repl-reader builtin-reader)
+  (lambda (ns)
+    (last-namespace ns)
+    (printf "mzscheme@(~a)" (namespace->module-name ns))
+    (builtin-reader)))
+
 ;;; eval.ss ends here
-- 
cgit v1.2.3