summaryrefslogtreecommitdiff
path: root/scheme/racket/geiser
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-11 16:27:01 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-11 16:27:01 +0100
commit8d1e1c47563131cd0f52f0cc02fa0b23eebd2227 (patch)
treebd616c0bf1c0a57062f8b0bb9dc702f7edb813e5 /scheme/racket/geiser
parentd773c05503659047f35878bd745568ce04078148 (diff)
downloadgeiser-guile-8d1e1c47563131cd0f52f0cc02fa0b23eebd2227.tar.gz
geiser-guile-8d1e1c47563131cd0f52f0cc02fa0b23eebd2227.tar.bz2
Racket reconnected
Diffstat (limited to 'scheme/racket/geiser')
-rw-r--r--scheme/racket/geiser/server.rkt12
-rw-r--r--scheme/racket/geiser/user.rkt59
2 files changed, 48 insertions, 23 deletions
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))