From 8d1e1c47563131cd0f52f0cc02fa0b23eebd2227 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 11 Nov 2010 16:27:01 +0100
Subject: Racket reconnected

---
 scheme/racket/geiser/server.rkt | 12 ++-------
 scheme/racket/geiser/user.rkt   | 59 ++++++++++++++++++++++++++++++++---------
 2 files changed, 48 insertions(+), 23 deletions(-)

(limited to 'scheme/racket/geiser')

diff --git a/scheme/racket/geiser/server.rkt b/scheme/racket/geiser/server.rkt
index cf86b2c..10b15a1 100644
--- a/scheme/racket/geiser/server.rkt
+++ b/scheme/racket/geiser/server.rkt
@@ -11,14 +11,6 @@
 
 #lang racket/base
 
-(require geiser/user mzlib/thread)
-(provide run-geiser-server start-geiser)
+(require geiser/user)
+(provide 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 412cfe7..9d5b169 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -11,10 +11,15 @@
 
 #lang racket/base
 
-(provide init-geiser-repl run-geiser-repl enter!)
+(provide init-geiser-repl run-geiser-server start-geiser)
 
 (require (for-syntax racket/base)
-	 geiser/main geiser/enter geiser/eval geiser/modules)
+         mzlib/thread
+         racket/tcp
+         geiser/main
+         geiser/enter
+         geiser/eval
+         geiser/modules)
 
 (define top-namespace (current-namespace))
 
@@ -42,29 +47,38 @@
                          (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)])))))
+                                  (eval-in `(,proc ,@args) mod lang))]
+                               [else (eval-in form mod lang)])))))
 
-(define (geiser-read)
-  (printf "racket@~a> " (namespace->module-name (current-namespace)))
+(define ((geiser-read prompt))
+  (prompt)
   (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))
        (case (syntax-e #'cmd)
-         ((enter) (enter! (read) #'cmd))
-         ((geiser-eval) (geiser-eval))
-         ((geiser-no-values) (datum->syntax #f (void)))
-         (else form))]
+         [(start-geiser) (datum->syntax #f `(list 'port ,(start-geiser)))]
+         [(enter) (enter! (read) #'cmd)]
+         [(geiser-eval) (geiser-eval)]
+         [(geiser-no-values) (datum->syntax #f (void))]
+         [else form])]
       [_ form])))
 
-(define geiser-prompt-read (make-repl-reader geiser-read))
+(define geiser-prompt
+  (lambda () (printf "> ")))
+
+(define geiser-server-prompt
+  (lambda ()
+    (printf "racket@~a> " (namespace->module-name (current-namespace)))))
+
+(define (geiser-prompt-read prompt)
+  (make-repl-reader (geiser-read prompt)))
 
 (define (init-geiser-repl)
   (compile-enforce-module-constants #f)
   (current-load/use-compiled geiser-loader)
-  (current-prompt-read geiser-prompt-read))
+  (current-prompt-read (geiser-prompt-read geiser-prompt)))
 
 (define (run-geiser-repl in out enforce-module-constants)
   (parameterize [(compile-enforce-module-constants enforce-module-constants)
@@ -72,5 +86,24 @@
                  (current-output-port out)
                  (current-error-port out)
                  (current-load/use-compiled geiser-loader)
-                 (current-prompt-read geiser-prompt-read)]
+                 (current-prompt-read (geiser-prompt-read
+                                       geiser-server-prompt))]
     (read-eval-print-loop)))
+
+(define server-channel (make-channel))
+
+(define (run-geiser-server port enforce-module-constants)
+  (run-server port
+              (lambda (in out)
+                (run-geiser-repl in out enforce-module-constants))
+              #f
+              void
+              (lambda (p _ __)
+                (let ([lsner (tcp-listen p)])
+                  (let-values ([(_ p __ ___) (tcp-addresses lsner #t)])
+                    (channel-put server-channel p)
+                    lsner)))))
+
+(define (start-geiser (port 0) (enforce-module-constants #f))
+  (thread (lambda () (run-geiser-server port enforce-module-constants)))
+  (channel-get server-channel))
-- 
cgit v1.2.3