4 files changed, 76 insertions, 33 deletions

diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt
index 4e7f3db..78db857 100644
--- a/scheme/racket/geiser/eval.rkt
+++ b/scheme/racket/geiser/eval.rkt
@@ -17,15 +17,13 @@
          compile-file
          macroexpand
          make-repl-reader)
+	 
 
 (require geiser/enter geiser/modules geiser/autodoc)
 (require errortrace/errortrace-lib)
 
 (define last-result (void))
 
-(define namespace->module-name
-  (compose module-path-name->name namespace->module-path-name))
-
 (define last-namespace (make-parameter (current-namespace)))
 
 (define (exn-key e)
@@ -55,10 +53,11 @@
     (append last-result `((output . ,output)))))
 
 (define (eval-in form spec lang)
-  (call-with-result
-   (lambda ()
-     (update-signature-cache spec form)
-     (eval form (module-spec->namespace spec lang)))))
+  (write (call-with-result
+          (lambda ()
+            (update-signature-cache spec form)
+            (eval form (module-spec->namespace spec lang)))))
+  (newline))
 
 (define compile-in eval-in)
 
@@ -74,10 +73,9 @@
       (lambda ()
         (pretty-print (syntax->datum ((if all expand expand-once) form)))))))
 
-(define (make-repl-reader builtin-reader)
-  (lambda (ns)
-    (last-namespace ns)
-    (printf "racket@~a" (namespace->module-name ns))
-    (builtin-reader)))
+(define (make-repl-reader reader)
+  (lambda ()
+    (last-namespace (current-namespace))
+    (reader)))
 
 ;;; eval.rkt ends here
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 9b640ec..0591a92 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -14,6 +14,7 @@
 (provide load-module
          ensure-module-spec
          module-spec->namespace
+	 namespace->module-name
          namespace->module-path-name
          module-path-name->name
          module-spec->path-name
@@ -74,11 +75,14 @@
                (call-with-values (lambda () (split-path path))
                  (lambda (_ basename __) (path->string basename)))
                (regexp-replace "\\.[^./]*$" real-path "")))]
-        [(eq? path '#%kernel) "(kernel)"]
+        ;; [(eq? path '#%kernel) "(kernel)"]
         [(string? path) path]
         [(symbol? path) (symbol->string path)]
         [else ""]))
 
+(define namespace->module-name
+  (compose module-path-name->name namespace->module-path-name))
+
 (define (skippable-dir? path)
   (call-with-values (lambda () (split-path path))
     (lambda (_ basename __)
diff --git a/scheme/racket/geiser/server.rkt b/scheme/racket/geiser/server.rkt
new file mode 100644
index 0000000..cf86b2c
--- /dev/null
+++ b/scheme/racket/geiser/server.rkt
@@ -0,0 +1,24 @@
+;;; server.rkt -- REPL server
+
+;; Copyright (c) 2010 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
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sat Nov 06, 2010 15:15
+
+#lang racket/base
+
+(require geiser/user mzlib/thread)
+(provide run-geiser-server start-geiser)
+
+(define (run-geiser-server port enforce-module-constants)
+  (run-server port
+              (lambda (in out)
+                (run-geiser-repl in out enforce-module-constants))
+              #f))
+
+(define (start-geiser (port 1969) (enforce-module-constants #f))
+  (thread (lambda () (run-geiser-server port enforce-module-constants))))
diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt
index 20f8a00..37763b9 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -11,9 +11,10 @@
 
 #lang racket/base
 
-(provide enter!)
+(provide init-geiser-repl run-geiser-repl enter!)
 
-(require geiser/main geiser/enter geiser/eval (for-syntax racket/base))
+(require (for-syntax racket/base)
+	 geiser/main geiser/enter geiser/eval geiser/modules)
 
 (define top-namespace (current-namespace))
 
@@ -29,37 +30,53 @@
                mod))))
 
 (define orig-loader (current-load/use-compiled))
+(define geiser-loader (module-loader orig-loader))
 
-(define orig-reader (current-prompt-read))
+(define geiser-send-null (make-parameter #f))
 
 (define (geiser-eval)
   (define geiser-main (module->namespace 'geiser/main))
-  (let* ((mod (read))
-         (lang (read))
-         (form (read)))
+  (geiser-send-null #t)
+  (let* ([mod (read)]
+         [lang (read)]
+         [form (read)])
     (datum->syntax #f
                    (list 'quote
-                         (cond ((equal? form '(unquote apply))
-                                (let* ((proc (eval (read) geiser-main))
-                                       (args (read)))
-                                  ((geiser:eval lang) `(,proc ,@args) mod)))
-                               (else ((geiser:eval lang) form mod)))))))
+                         (cond [(equal? form '(unquote apply))
+                                (let* ([proc (eval (read) geiser-main)]
+                                       [args (read)])
+                                  ((geiser:eval lang) `(,proc ,@args) mod))]
+                               [else ((geiser:eval lang) form mod)])))))
 
 (define (geiser-read)
-  (let ((form (orig-reader)))
+  (if (geiser-send-null)
+      (begin (geiser-send-null #f)
+	     (write-char #\nul))
+      (printf "racket@~a> " (namespace->module-name (current-namespace))))
+  (flush-output)
+  (let* ([in (current-input-port)]
+	 [form ((current-read-interaction) (object-name in) in)])
     (syntax-case form ()
-      ((uq cmd) (eq? 'unquote (syntax-e #'uq))
+      [(uq cmd) (eq? 'unquote (syntax-e #'uq))
        (case (syntax-e #'cmd)
          ((enter) (enter! (read) #'cmd))
          ((geiser-eval) (geiser-eval))
          ((geiser-no-values) (datum->syntax #f (void)))
-         (else form)))
-      (_ form))))
+         (else form))]
+      [_ form])))
 
-(define (init)
+(define geiser-prompt-read (make-repl-reader geiser-read))
+
+(define (init-geiser-repl)
   (compile-enforce-module-constants #f)
-  (current-load/use-compiled (module-loader orig-loader))
-  (current-prompt-read
-   (compose (make-repl-reader geiser-read) current-namespace)))
+  (current-load/use-compiled geiser-loader)
+  (current-prompt-read geiser-prompt-read))
 
-(init)
+(define (run-geiser-repl in out enforce-module-constants)
+  (parameterize [(compile-enforce-module-constants enforce-module-constants)
+                 (current-input-port in)
+                 (current-output-port out)
+                 (current-error-port out)
+                 (current-load/use-compiled geiser-loader)
+                 (current-prompt-read geiser-prompt-read)]
+    (read-eval-print-loop)))